home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr53
/
cismsg15.zip
/
CISLIBSC.SC
< prev
next >
Wrap
Text File
|
1993-06-04
|
136KB
|
3,358 lines
;*************************************************************************
;*************************************************************************
; Formatted Source Listing
; Date : 05/26/93
; Time : 15:42:15
;
; System : CISMSG The PARADOX-CIS Message Program
; File Name : C:\CIS\BATSYS.SC
; By : James Cap Walker and Mark Hout with HELP from Freinds!
; Last modified 05/16/93 11:29:08 am
; Copyright (c) 1992-1993 BAT-Systems Consulting
; This program is represents a collection of code by:
; Tony Goodman
; Dan Erhmann
; Angelo Laudon
; Dan Paolini
; Desmond Nolan
; John Nelson
; Michael Hyatt
; James Cap Walker
; Micael J. Hyatt
;*************************************************************************
;*************************************************************************
CREATELIB "Paradox" SIZE 150
LIBNAME= "Paradox"
PROCSTEP.N = 0
PROCTOTAL.N = 39
MESSAGE "Writing lib " + LIBNAME
PROC FIXMSGBOX(DT)
ECHO OFF
if dt = 2 then
MaxWindow(FormWindow)
endif
IF UPPER(TABLE()) = "IDL" OR UPPER(TABLE()) = "LASTDL" THEN
MOVETO [description]
ELSE
MOVETO [message]
ENDIF
FIELDVIEW
DYNARRAY MEMOWINATTS[]
MEMOWINDOW=GETWINDOW()
; MemoWinAtts["CANMAXIMIZE"] = False
MEMOWINATTS["CANRESIZE"] = FALSE
MEMOWINATTS["HASFRAME"] = TRUE
WINDOW RESIZE GETWINDOW() TO 11, 80
WINDOW MOVE GETWINDOW() TO 11, 0
SETWINDOW(GETWINDOW(),1)
WINDOW SETATTRIBUTES MEMOWINDOW FROM MEMOWINATTS
WINNEXT
FORMKEY
SETWINDOW(FormWindow,2)
Moveto [FORUM]
ARRANGED = TRUE
ECHO NORMAL
ENDPROC
WRITELIB LIBNAME FIXMSGBOX
RELEASE PROCS FIXMSGBOX
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "FixMsgBox" )
PROC SPLASHSCR(NBR)
MESSAGE.U("CIS ACTIVITY CENTER", "Moose & Squirrel Software//CompuServ Message Handler Program//(C) 1992-93" ,TRUE,FALSE)
CLEARALL
IF NBR = 1 THEN
BEEPEM.U("Alert")
SLEEP 1000
ENDIF
ENDPROC
WRITELIB LIBNAME SPLASHSCR
RELEASE PROCS SPLASHSCR
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "SplashScr" )
PROC GETMSGCOUNT()
PRIVATE ANTBLWIN
ECHO OFF
MESSAGE.U("QUERY", "Processing Message Crosstab Query//Please Wait..." ,TRUE,FALSE)
{Ask} SELECT "Icistat"
[Msg Number] = "Calc Count"
MOVETO [Date] CHECK
MOVETO [From Name] CHECK
DO_IT!
CLEARALL
VIEW "Answer"
ANTBLWIN=GETWINDOW()
WINDOW MOVE ANTBLWIN TO 10,-300
MOVETO [date]
MENU {Image} {Move} {Date}
RIGHT
ENTER
LEFT
MENU {Image} {Graph} {CrossTab} {1) Sum}
ENTER
RIGHT
ENTER
RIGHT
ENTER
MENU {Tools} {ExportImport} {Export} {Quattro} {2) Quattro Pro}
{Crosstab} {msgcnt}
CLEARALL
CLEARMESSAGE.U()
WBSFILLSCREEN()
ENDPROC
WRITELIB LIBNAME GETMSGCOUNT
RELEASE PROCS GETMSGCOUNT
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "GetMsgCount" )
; ════════════════════════════════════════════════════════════════════════════
; Script: MSGTOOLS.SC, Version 0.90 Beta
; Author: Michael S. Hyatt, CIS ID: 72611,2226
; Description: One of the most basic kinds of tools that most developers
; need is "message tools," a collection of utilities for
; keeping the user informed of what's going on and soliciting
; decisions from him when necessary. Some of the ideas for
; these procedures were inspired by GUITools for Paradox 3.5,
; (published by Ensemble Corporation and a "must-have" for
; anyone doing serious Paradox development), but these
; routines were re-written to take advantage of the dialog
; box and window commands found in Paradox 4.0.
; Includes: BeepEm.u() Send an audio "signal" to the user.
; ClearMessage.u() Clears message previously created with
; Message.u.
; Continue.u() Displays a message and requires the
; user to press a "Continue" button to
; continue the process.
; ContinueCancel.l() Same as Continue.u but gives the user
; the opportunity to cancel out of the
; process.
; Message.u() Displays a message on the screen in
; a window to let the user know what is
; happening.
; Ok.u() Same as Continue.u, but the pushbutton
; is labeled "Ok."
; YesNo.u() Displays a question on the screen in
; a window and requires the user to
; answer "Yes" or "No."
; Notice: These procedures are released as FreeWare in gratitude for
; all the *tremendous* help I have received from others in
; CompuServe's PDoxDos forum. Enjoy!
; Created: 10-01-92 07:03pm
; Modified: 10-11-92 12:33pm
; ════════════════════════════════════════════════════════════════════════════
; ────────────────────────────────────────────────────────────────────────────
; Procedure: BeepEm.u()
; Description: Sends a specific audio signal to the user based on the
; parameter specified when calling the procedure.
; Syntax: BeepEm.u(BeepType.a)
; Arguments: BeepType.a is one of three different types of audio
; signals: (1) "Alert", (2) "Error", or (3) "Illegal".
; Return Value: BeepEm.u returns no value.
; Usage: BeepEm.u is used whenever you want to send an audio signal
; to the user. It is automatically called by many of the
; procedures in the MsgTools collection, but it may also
; be called on its own.
; Example: BeepEm.u("Alert")
; ────────────────────────────────────────────────────────────────────────────
PROC BEEPEM.U(BEEPTYPE.A)
PROCNAME.A = "BeepEm.u"
SWITCH
CASE UPPER(BEEPTYPE.A) = "ALERT" :
SOUND 200 50 SOUND 200 50 SOUND 200 50 SOUND 400 50 SOUND 800 50
CASE UPPER(BEEPTYPE.A) = "ERROR" :
SOUND 400 100 SOUND 380 100 SOUND 400 100 SOUND 100 200
CASE UPPER(BEEPTYPE.A) = "ILLEGAL" :
SOUND 800 100 SOUND 400 50
ENDSWITCH
ENDPROC
WRITELIB LIBNAME BEEPEM.U
RELEASE PROCS BEEPEM.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Beeper.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: ClearMessage.u()
; Description: Clears a message previously created by Message.u().
; Syntax: ClearMessage.u()
; Arguments: ClearMessage.u takes no arguments.
; Return Value: ClearMessage.u returns no value.
; Usage: Because Message.u utilizes a window, it must be explicitly
; closed with a Window Close command.
; Example: Message.u("Alert", "Sending report to printer./" +
; "Please wait...", True, True)
; ... do some other commands ...
; ClearMessage.u()
; ────────────────────────────────────────────────────────────────────────────
PROC CLEARMESSAGE.U()
PROCNAME.A = "ClearMessage.u"
WINDOW SELECT MSG.H
WINDOW
CLOSE
ENDPROC
WRITELIB LIBNAME CLEARMESSAGE.U
RELEASE PROCS CLEARMESSAGE.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ClearMessage.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: Continue.u()
; Description: Displays a dialog box with a user-defined message and a
; single pushbutton labeled "Continue." The message can be
; one or several lines long. The procedure stops whatever
; process is underway and waits for the user to push the
; button before continuing.
; Syntax: Continue.u(Title.a, Message.a, Frame.l, Beep.l)
; Arguments: Title.a: Title.a is a character string containing the
; title of the dialog box, which Paradox centers on the
; top of the window frame.
; Message.a: Message.a is a character string expression
; which is displayed as a message above the pushbutton. It
; can be more than one line. Each line is separated by the
; "/" character. (See examples below.)
; Frame.l: Frame.l is a logical (True/False) expression which
; indicates that the message is displayed within an inter-
; ior GUI frame. "True" indicates that the proc should use
; a frame; "false" indicates that it should not.
; Beep.l: Beep.l is a logical (True/False) expression which
; indicates that a "beep" should accompany the display of
; the dialog box. "True" indicates yes; "False," no.
; Return Value: Continue.u returns no value.
; Usage: Continue.u is used whenever you want to interrupt a process
; and display a message to the user before continuing. For
; example, it could be called before printing a long report.
; Example: Continue.u("Alert", "This process will take a while./" +
; "You might want to take a coffee break.", True, True)
;────────────────────────────────────────────────────────────────────────────
PROC CONTINUE.U(TITLE.A, MESSAGE.A, FRAME.L, BEEP.L)
PRIVATE MSGSEG.A, ; Unparsed message segment
LENGTH.N, ; length of longest line
NLINES.N, ; number of message lines
MSG.A, ; Placeholder for Match()
SROW.N, ; Starting row
SCOL.N, ; Starting column
CTRFORMAT.A ; Format for centering text
PROCNAME.A = "Continue.u" ; Note the proc name in case we
; encounter an error.
ECHO OFF ; "Turn out the lights."
MSGSEG.A = MESSAGE.A ; Initialize variables
LENGTH.N = 0
NLINES.N = 1
WHILE MATCH(MSGSEG.A, "../.." , ; Determine how many lines there
MSG.A, MSGSEG.A) ; are and how long the longest
LENGTH.N = MAX(LENGTH.N, LEN(MSG.A)) ; one is.
NLINES.N = NLINES.N + 1
ENDWHILE
LENGTH.N = MAX(LENGTH.N, LEN(MSGSEG.A)) ; The last line won't run through
; the above loop, so we have to
; compare its length against the
; longest line so far.
LENGTH.N = MAX(LENGTH.N, 12) ; Make sure the box is big enough
; to accomodate the buttons.
LENGTH.N = MIN(LENGTH.N, 72) ; Make sure the longest line is
; not longer than 72 characters.
IF FRAME.L THEN ; Add padding to line length to
LENGTH.N = LENGTH.N + 8 ; allow for dialog box frame,
NLINES.N = NLINES.N + 7 ; interior frame, and button.
ELSE
LENGTH.N = LENGTH.N + 6 ; If there's no interior frame,
NLINES.N = NLINES.N + 6 ; then we can reduce the overall
; size of the dialog box.
ENDIF
SROW.N= 12 - INT(NLINES.N / 2) ; Determine starting row.
SCOL.N = 40 - INT(LENGTH.N / 2) ; Determine starting col.
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 6) + ", ac" ; centers screen in width.
SHOWDIALOG
TITLE.A ; Display the dialog box.
PROC "ContinueWaitProc.u" ; Specify the WaitProc to call
TRIGGER "Open" ; the "Open" trigger is generated.
@SROW.N, SCOL.N
HEIGHT NLINES.N WIDTH LENGTH.N ; Dialog box coordinates.
PUSHBUTTON @NLINES.N - 4, ; [Continue] Pushbutton
INT((LENGTH.N / 2) - 8)
WIDTH 14
"~C~ontinue"
OK
DEFAULT ; The default button (duh)
VALUE "Continue"
TAG "ContinueTag"
TO BUTTONVALUE.A
ENDDIALOG
ENDPROC
WRITELIB LIBNAME CONTINUE.U
RELEASE PROCS CONTINUE.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Continue.u" )
; ────────────────────────────────────────────────────────────────────────────
; This proc is called by the ShowDialog command in Continue.u(). It follows
; the standard WaitProc format.
; ────────────────────────────────────────────────────────────────────────────
PROC CONTINUEWAITPROC.U(TRIGGERTYPE.A, TAGVALUE.A, EVENTRECORD.Y, CYCLE.N)
PRIVATE LASTLINE.A, ; Lastline of message.
ELLIPSES.N ; Placeholder for ellipses search
PROCNAME.A = "ContinueWaitProc.u" ; Note the proc name in case we
; encounter an error.
WINDOW HANDLE DIALOG TO CONTINUE.H ; Give this dialog box a handle.
SETCANVAS CONTINUE.H ; Set the canvas to the dialog
; box, so that we can write to it.
CANVAS OFF ; Turn the canvas off while we
; draw the message and frame.
STYLE ATTRIBUTE SYSCOLOR(1036) ; Use the default background text
; for Dialog boxes.
IF FRAME.L THEN ; See if the user wants an inter-
FRAME SINGLE ; ior frame; if so, draw it.
FROM 0, 1 TO NLINES.N - 6,
LENGTH.N - 4
; Now paint the frame--GUI-style.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Top line of frame box.
0, 1, 0, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Left line of frame box.
0, 1, NLINES.N - 6, 1
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Right line of frame box.
0, LENGTH.N - 4,
NLINES.N - 6, LENGTH.N - 4
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Bottom line of frame box.
NLINES.N - 6, 2,
NLINES.N - 6, LENGTH.N - 5
ENDIF
MSGSEG.A = MESSAGE.A ; Re-initialize variables.
SROW.N= 1
SCOL.N = 2
WHILE MATCH(MSGSEG.A, "../.." , ; Parse the message, and paint
MSG.A, MSGSEG.A) ; the canvas, one line at a time.
@ SROW.N, SCOL.N
?? FORMAT(CTRFORMAT.A, MSG.A)
SROW.N= SROW.N + 1 ; Move down one row.
ENDWHILE
LASTLINE.A = FORMAT(CTRFORMAT.A, ; Format the last line.
MSGSEG.A)
@ SROW.N, SCOL.N ?? LASTLINE.A ; Put it on the canvas.
ELLIPSES.N = SEARCH("...", LASTLINE.A) ; Check for ellipses.
IF ELLIPSES.N > 0 THEN ; If there's an ellipses, then
STYLE ATTRIBUTE SYSCOLOR(1036) + 128 ; paint it with the blinking
@ SROW.N, ; attribute.
SCOL.N + ELLIPSES.N - 1 ?? "..."
ENDIF
CANVAS ON ; Display the completely-drawn
; message.
IF BEEP.L THEN ; Check to see if the user wants
BEEPEM.U("Alert") ; a beep. If so, call the proc.
ENDIF
ENDPROC
WRITELIB LIBNAME CONTINUEWAITPROC.U
RELEASE PROCS CONTINUEWAITPROC.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ContinueWait.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: ContinueCancel.l()
; Description: Displays a dialog box with a user-defined message (usually
; a question) and two pushbuttons labeled "Yes" and "No."
; The message can be one or several lines long. The procedure
; stops whatever process is underway and waits for the user
; make a decision.
; Syntax: ContinueCancel.l(Title.a, Message.a, Frame.l, Beep.l)
; Arguments: Title.a: Title.a is a character string containing the
; title of the dialog box, which Paradox centers on the
; top of the window frame.
; Message.a: Message.a is a character string expression
; which is displayed as a message above the pushbutton. It
; can be more than one line. Each line is separated by the
; "/" character. (See examples below.)
; Frame.l: Frame.l is a logical (True/False) expression which
; indicates that the message is displayed within an inter-
; ior GUI frame. "True" indicates that the proc should use
; a frame; "false" indicates that it should not.
; Beep.l: Beep.l is a logical (True/False) expression which
; indicates that a "beep" should accompany the display of
; the dialog box. "True" indicates yes; "False," no.
; Return Value: ContinueCancel.l returns logical True of the user pressed
; [Continue] and logical False is the user pressed [Cancel].
; Usage: ContinueCancel.l is used whenever you need to get a
; decision from the the user before continuing. For example, it could
; be called before backing up a table.
; Example: ContinueCancel.l("Alert", "Ready to backup up database
; files?", True, True)
;────────────────────────────────────────────────────────────────────────────
PROC CONTINUECANCEL.L(TITLE.A, MESSAGE.A, FRAME.L, BEEP.L)
PRIVATE MSGSEG.A, ; Unparsed message segment
LENGTH.N, ; length of longest line
NLINES.N, ; number of message lines
MSG.A, ; Placeholder for Match()
SROW.N, ; Starting row
SCOL.N, ; Starting column
CTRFORMAT.A ; Format for centering text
PROCNAME.A = "ContinueCancel.l" ; Note the proc name in case we
; encounter an error.
ECHO OFF ; "Turn out the lights."
MSGSEG.A = MESSAGE.A ; Initialize variables
LENGTH.N = 0
NLINES.N = 1
WHILE MATCH(MSGSEG.A, "../.." , ; Determine how many lines there
MSG.A, MSGSEG.A) ; are and how long the longest
LENGTH.N = MAX(LENGTH.N, LEN(MSG.A)) ; one is.
NLINES.N = NLINES.N + 1
ENDWHILE
LENGTH.N = MAX(LENGTH.N, LEN(MSGSEG.A)) ; The last line won't run through
; the above loop, so we have to
; compare its length against the
; longest line so far.
LENGTH.N = MAX(LENGTH.N, 26) ; Make sure the box is big enough
; to accomodate the buttons.
LENGTH.N = MIN(LENGTH.N, 72) ; Make sure the longest line is
; not longer than 72 characters.
IF FRAME.L THEN ; Add padding to line length to
LENGTH.N = LENGTH.N + 8 ; allow for dialog box frame,
NLINES.N = NLINES.N + 7 ; interior frame, and button.
ELSE
LENGTH.N = LENGTH.N + 6 ; If there's no interior frame,
NLINES.N = NLINES.N + 6 ; then we can reduce the overall
; size of the dialog box.
ENDIF
SROW.N= 12 - INT(NLINES.N / 2) ; Determine starting row.
SCOL.N = 40 - INT(LENGTH.N / 2) ; Determine starting col.
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 6) + ", ac" ; centers screen in width.
SHOWDIALOG
TITLE.A ; Display the dialog box.
PROC "ContinueCancelWaitProc.u" ; Specify the WaitProc to call
TRIGGER "Open" ; the "Open" trigger is generated.
@SROW.N, SCOL.N
HEIGHT NLINES.N WIDTH LENGTH.N ; Dialog box coordinates.
PUSHBUTTON @NLINES.N - 4, ; [Continue] Pushbutton
INT((LENGTH.N / 2) - 15)
WIDTH 14
"C~o~ntinue"
OK
DEFAULT ; The default button (duh!)
VALUE "Continue"
TAG "ContinueTag"
TO BUTTONVALUE.A
PUSHBUTTON @NLINES.N - 4, ; [Cancel] Pushbutton
INT((LENGTH.N / 2) - 1)
WIDTH 14
"~C~ancel"
CANCEL
VALUE "Cancel"
TAG "CancelTAG"
TO BUTTONVALUE.A
ENDDIALOG
RETURN RETVAL
ENDPROC
WRITELIB LIBNAME CONTINUECANCEL.L
RELEASE PROCS CONTINUECANCEL.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ContinueCancel.u" )
; ────────────────────────────────────────────────────────────────────────────
; This proc is called by the ShowDialog command in ContinueCancel.l(). It follows the
; standard WaitProc format.
; ────────────────────────────────────────────────────────────────────────────
PROC CONTINUECANCELWAITPROC.U(TRIGGERTYPE.A, TAGVALUE.A, EVENTRECORD.Y, CYCLE.N)
PRIVATE LASTLINE.A, ; Lastline of message.
ELLIPSES.N ; Placeholder for ellipses search
PROCNAME.A = "ContinueCancelWaitProc.u" ; Note the proc name in case we
; encounter an error.
WINDOW HANDLE DIALOG TO CONTINUECANCEL.H ; Give this dialog box a handle.
SETCANVAS CONTINUECANCEL.H ; Set the canvas to the dialog
; box, so that we can write to it.
CANVAS OFF ; Turn the canvas off while we
; draw the message and frame.
STYLE ATTRIBUTE SYSCOLOR(1036) ; Use the default background text
; for Dialog boxes.
IF FRAME.L THEN ; See if the user wants an inter-
FRAME SINGLE ; ior frame; if so, draw it.
FROM 0, 1 TO NLINES.N - 6,
LENGTH.N - 4
; Now paint the frame--GUI-style.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Top line of frame box.
0, 1, 0, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Left line of frame box.
0, 1, NLINES.N - 6, 1
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Right line of frame box.
0, LENGTH.N - 4,
NLINES.N - 6, LENGTH.N - 4
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Bottom line of frame box.
NLINES.N - 6, 2,
NLINES.N - 6, LENGTH.N - 5
ENDIF
MSGSEG.A = MESSAGE.A ; Re-initialize variables.
SROW.N= 1
SCOL.N = 2
WHILE MATCH(MSGSEG.A, "../.." , ; Parse the message, and paint
MSG.A, MSGSEG.A) ; the canvas, one line at a time.
@ SROW.N, SCOL.N
?? FORMAT(CTRFORMAT.A, MSG.A)
SROW.N= SROW.N + 1 ; Move down one row.
ENDWHILE
LASTLINE.A = FORMAT(CTRFORMAT.A, ; Format the last line.
MSGSEG.A)
@ SROW.N, SCOL.N ?? LASTLINE.A ; Put it on the canvas.
ELLIPSES.N = SEARCH("...", LASTLINE.A) ; Check for ellipses.
IF ELLIPSES.N > 0 THEN ; If there's an ellipses, then
STYLE ATTRIBUTE SYSCOLOR(1036) + 128 ; paint it with the blinking
@ SROW.N, ; attribute.
SCOL.N + ELLIPSES.N - 1 ?? "..."
ENDIF
CANVAS ON ; Display the completely-drawn
; message.
IF BEEP.L THEN ; Check to see if the user wants
BEEPEM.U("Alert") ; a beep. If so, call the proc.
ENDIF
ENDPROC
WRITELIB LIBNAME CONTINUECANCELWAITPROC.U
RELEASE PROCS CONTINUECANCELWAITPROC.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ContinueCancelWait.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: Message.u()
; Description: Displays a floating window with a user-defined message
; painted on it. The "floating" attribute assures that the
; window is always above other objects on the workspace (e.g.,
; dialog boxes). The message can be one or several lines
;
; Syntax: Message.u(Title.a, Message.a, Frame.l, Beep.l)
; Arguments: Title.a: Title.a is a character string containing the
; title of the window, which Paradox centers on the top
; of the window frame.
; Message.a: Message.a is a character string expression
; which is displayed as a message within the window. It
; can be more than one line. Each line is separated by the
; "/" character. (See examples below.)
; Frame.l: Frame.l is a logical (True/False) expression which
; indicates that the message is displayed within an inter-
; ior GUI frame. "True" indicates that the proc should use
; a frame; "false" indicates that it should not.
; Beep.l: Beep.l is a logical (True/False) expression which
; indicates that a "beep" should accompany the display of
; the window. "True" indicates yes; "False," no.
; Return Value: Message.u returns no value.
; Usage: Message.u is used whenever you let the user know what's
; happening. This is especially important during long proce-
; dures or delays when the user might assume something is
; wrong. The message is displayed with Message.u(), and it
; is explicitly removed with ClearMessage.u().
; Example: Message.u("Alert", "Sending report to printer./" +
; "Please wait...", True, True)
;────────────────────────────────────────────────────────────────────────────
PROC MESSAGE.U(TITLE.A, MESSAGE.A, FRAME.L, BEEP.L)
PRIVATE MSGSEG.A, ; Unparsed message segment
LENGTH.N, ; length of longest line
NLINES.N, ; number of message lines
MSG.A, ; Placeholder for Match()
SROW.N, ; Starting row
SCOL.N, ; Starting column
CTRFORMAT.A, ; Format for centering text
MSGWATTR.Y ; Attributes for message window
PROCNAME.A = "Message.u" ; Note the proc name in case we
; encounter an error.
SETCANVAS DEFAULT ; Set the default canvas.
CANVAS OFF
ECHO NORMAL
ECHO OFF ; "Turn out the lights."
CURSOR OFF
MSGSEG.A = MESSAGE.A ; Initialize variables
LENGTH.N = 0
NLINES.N = 1
DYNARRAY MSGWATTR.Y[]
MSGWATTR.Y["HasFrame"] = FALSE
WHILE MATCH(MSGSEG.A, "../.." , ; Determine how many lines there
MSG.A, MSGSEG.A) ; are and how long the longest
LENGTH.N = MAX(LENGTH.N, LEN(MSG.A)) ; one is.
NLINES.N = NLINES.N + 1
ENDWHILE
LENGTH.N = MAX(LENGTH.N, LEN(MSGSEG.A)) ; The last line won't run through
; the above loop, so we have to
; compare its length against the
; longest line so far.
LENGTH.N = MAX(LENGTH.N, 12) ; Make sure the box is big enough.
LENGTH.N = MIN(LENGTH.N, 72) ; Make sure the longest line is
; not longer than 72 characters.
IF FRAME.L THEN ; Add padding to line length to
LENGTH.N = LENGTH.N + 10 ; allow for window frame, and
NLINES.N = NLINES.N + 6 ; interior frame.
ELSE
LENGTH.N = LENGTH.N + 6 ; If there's no interior frame,
NLINES.N = NLINES.N + 4 ; then we can reduce the overall
; size of the dialog box.
ENDIF
SROW.N= 12 - INT(NLINES.N / 2) ; Determine starting row.
SCOL.N = 40 - INT(LENGTH.N / 2) ; Determine starting col.
IF FRAME.L THEN
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 8) + ", ac" ; centers screen in width.
ELSE
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 6) + ", ac" ; centers screen in width.
ENDIF
MSGWATTR.Y["OriginRow"] = SROW.N
MSGWATTR.Y["OriginCol"] = SCOL.N
WINDOW
CREATE FLOATING ; Create floating window.
@SROW.N + 1000, SCOL.N + 1000 ; Window coordinates.
HEIGHT NLINES.N WIDTH LENGTH.N ; Window size.
TO MSG.H ; Window handle.
WINDOW SETATTRIBUTES MSG.H ; Set the window's attributes
FROM MSGWATTR.Y ; (i.e., the "title")
SETCANVAS MSG.H ; Set the canvas to the window
; box, so that we can write to it.
CANVAS OFF ; Turn the canvas off while we
; draw the message and frame.
FRAME DOUBLE FROM ; Draw the double frame around the
0, 0 TO NLINES.N - 3, ; window. We don't want to use the
LENGTH.N - 3 ; normal window frame, because we
; we don't want the scroll bars.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Paint the double frame.
0, 0, NLINES.N - 3, LENGTH.N - 3
IF TITLE.A <> "" THEN
STYLE ATTRIBUTE SYSCOLOR(1032) ; Place the title in the middle of
@0, INT((LENGTH.N - 3) / 2 - ; the frame.
(LEN(TITLE.A) / 2)) ?? " " + ; Allow for a space before and
TITLE.A + " " ; after title.
ENDIF
IF FRAME.L THEN ; See if the user wants an inter-
FRAME SINGLE ; ior frame; if so, draw it.
FROM 1, 2 TO NLINES.N - 4,
LENGTH.N - 5
; Now paint the frame--GUI-style.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Top line of frame box.
1, 2, 1, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Left line of frame box.
1, 1, NLINES.N - 4, 1
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Right line of frame box.
1, LENGTH.N - 5,
NLINES.N - 4, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Bottom line of frame box.
NLINES.N - 4, 3,
NLINES.N - 4, LENGTH.N - 5
ENDIF
MSGSEG.A = MESSAGE.A ; Re-initialize variables.
IF FRAME.L THEN
SROW.N= 2
SCOL.N = 3
ELSE
SROW.N= 1
SCOL.N = 2
ENDIF
STYLE ATTRIBUTE SYSCOLOR(1036) ; Use the default background text
; for window text.
WHILE MATCH(MSGSEG.A, "../.." , ; Parse the message, and paint
MSG.A, MSGSEG.A) ; the canvas, one line at a time.
@ SROW.N, SCOL.N
?? FORMAT(CTRFORMAT.A, MSG.A)
SROW.N= SROW.N + 1 ; Move down one row.
ENDWHILE
LASTLINE.A = FORMAT(CTRFORMAT.A, ; Format the last line.
MSGSEG.A)
@ SROW.N, SCOL.N ?? LASTLINE.A ; Put it on the canvas.
ELLIPSES.N = SEARCH("...", LASTLINE.A) ; Check for ellipses.
IF ELLIPSES.N > 0 THEN ; If there's an ellipses, then
STYLE ATTRIBUTE SYSCOLOR(1036) + 128 ; paint it with the blinking
@ SROW.N, ; attribute.
SCOL.N + ELLIPSES.N - 1 ?? "..."
ENDIF
CANVAS ON ; Display the completely-drawn
; message.
IF BEEP.L THEN ; Check to see if the user wants
BEEPEM.U("Alert") ; a beep. If so, call the proc.
ENDIF
ENDPROC
WRITELIB LIBNAME MESSAGE.U
RELEASE PROCS MESSAGE.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Message.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: Ok.u()
; Description: Displays a dialog box with a user-defined message and a
; single pushbutton labeled "Ok." The message can be
; one or several lines long. The procedure stops whatever
; process is underway and waits for the user to push the
; button before continuing.
; Syntax: Ok.u(Title.a, Message.a, Frame.l, Beep.l)
; Arguments: Title.a: Title.a is a character string containing the
; title of the dialog box, which Paradox centers on the
; top of the window frame.
; Message.a: Message.a is a character string expression
; which is displayed as a message above the pushbutton. It
; can be more than one line. Each line is separated by the
; "/" character. (See examples below.)
; Frame.l: Frame.l is a logical (True/False) expression which
; indicates that the message is displayed within an inter-
; ior GUI frame. "True" indicates that the proc should use
; a frame; "false" indicates that it should not.
; Beep.l: Beep.l is a logical (True/False) expression which
; indicates that a "beep" should accompany the display of
; the dialog box. "True" indicates yes; "False," no.
; Return Value: Ok.u returns no value.
; Usage: Ok.u is used whenever you want to interrupt a process
; and display a message to the user before continuing. For
; example, it could be called before printing a long report.
; Example: Ok.u("Alert", "You have to specify a beginning value./" +
; "Please try again.", True, True)
;────────────────────────────────────────────────────────────────────────────
PROC OK.U(TITLE.A, MESSAGE.A, FRAME.L, BEEP.L)
PRIVATE MSGSEG.A, ; Unparsed message segment
LENGTH.N, ; length of longest line
NLINES.N, ; number of message lines
MSG.A, ; Placeholder for Match()
SROW.N, ; Starting row
SCOL.N, ; Starting column
CTRFORMAT.A ; Format for centering text
PROCNAME.A = "Ok.u" ; Note the proc name in case we
; encounter an error.
ECHO OFF ; "Turn out the lights."
MSGSEG.A = MESSAGE.A ; Initialize variables
LENGTH.N = 0
NLINES.N = 1
WHILE MATCH(MSGSEG.A, "../.." , ; Determine how many lines there
MSG.A, MSGSEG.A) ; are and how long the longest
LENGTH.N = MAX(LENGTH.N, LEN(MSG.A)) ; one is.
NLINES.N = NLINES.N + 1
ENDWHILE
LENGTH.N = MAX(LENGTH.N, LEN(MSGSEG.A)) ; The last line won't run through
; the above loop, so we have to
; compare its length against the
; longest line so far.
LENGTH.N = MAX(LENGTH.N, 12) ; Make sure the box is big enough
; to accomodate button.
LENGTH.N = MIN(LENGTH.N, 72) ; Make sure the longest line is
; not longer than 72 characters.
IF FRAME.L THEN ; Add padding to line length to
LENGTH.N = LENGTH.N + 8 ; allow for dialog box frame,
NLINES.N = NLINES.N + 7 ; interior frame, and button.
ELSE
LENGTH.N = LENGTH.N + 6 ; If there's no interior frame,
NLINES.N = NLINES.N + 6 ; then we can reduce the overall
; size of the dialog box.
ENDIF
SROW.N= 12 - INT(NLINES.N / 2) ; Determine starting row.
SCOL.N = 40 - INT(LENGTH.N / 2) ; Determine starting col.
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 6) + ", ac" ; centers screen in width.
SHOWDIALOG
TITLE.A ; Display the dialog box.
PROC "OkWaitProc.u" ; Specify the WaitProc to call
TRIGGER "Open" ; the "Open" trigger is generated.
@SROW.N, SCOL.N
HEIGHT NLINES.N WIDTH LENGTH.N ; Dialog box coordinates.
PUSHBUTTON @NLINES.N - 4, ; [Ok] Pushbutton
INT((LENGTH.N / 2) - 6)
WIDTH 10
"~O~k"
OK
DEFAULT ; The default button (duh)
VALUE "Ok"
TAG "OkTag"
TO BUTTONVALUE.A
ENDDIALOG
ENDPROC
WRITELIB LIBNAME OK.U
RELEASE PROCS OK.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Ok.u" )
; ────────────────────────────────────────────────────────────────────────────
; This proc is called by the ShowDialog command in Ok.u(). It follows the
; standard WaitProc format.
; ────────────────────────────────────────────────────────────────────────────
PROC OKWAITPROC.U(TRIGGERTYPE.A, TAGVALUE.A, EVENTRECORD.Y, CYCLE.N)
PRIVATE LASTLINE.A, ; Lastline of message.
ELLIPSES.N ; Placeholder for ellipses search
PROCNAME.A = "OkWaitProc.u" ; Note the proc name in case we
; encounter an error.
WINDOW HANDLE DIALOG TO OK.H ; Give this dialog box a handle.
SETCANVAS OK.H ; Set the canvas to the dialog
; box, so that we can write to it.
CANVAS OFF ; Turn the canvas off while we
; draw the message and frame.
STYLE ATTRIBUTE SYSCOLOR(1036) ; Use the default background text
; for Dialog boxes.
IF FRAME.L THEN ; See if the user wants an inter-
FRAME SINGLE ; ior frame; if so, draw it.
FROM 0, 1 TO NLINES.N - 6,
LENGTH.N - 4
; Now paint the frame--GUI-style.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Top line of frame box.
0, 1, 0, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Left line of frame box.
0, 1, NLINES.N - 6, 1
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Right line of frame box.
0, LENGTH.N - 4,
NLINES.N - 6, LENGTH.N - 4
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Bottom line of frame box.
NLINES.N - 6, 2,
NLINES.N - 6, LENGTH.N - 5
ENDIF
MSGSEG.A = MESSAGE.A ; Re-initialize variables.
SROW.N= 1
SCOL.N = 2
WHILE MATCH(MSGSEG.A, "../.." , ; Parse the message, and paint
MSG.A, MSGSEG.A) ; the canvas, one line at a time.
@ SROW.N, SCOL.N
?? FORMAT(CTRFORMAT.A, MSG.A)
SROW.N= SROW.N + 1 ; Move down one row.
ENDWHILE
LASTLINE.A = FORMAT(CTRFORMAT.A, ; Format the last line.
MSGSEG.A)
@ SROW.N, SCOL.N ?? LASTLINE.A ; Put it on the canvas.
ELLIPSES.N = SEARCH("...", LASTLINE.A) ; Check for ellipses.
IF ELLIPSES.N > 0 THEN ; If there's an ellipses, then
STYLE ATTRIBUTE SYSCOLOR(1036) + 128 ; paint it with the blinking
@ SROW.N, ; attribute.
SCOL.N + ELLIPSES.N - 1 ?? "..."
ENDIF
CANVAS ON ; Display the completely-drawn
; message.
IF BEEP.L THEN ; Check to see if the user wants
BEEPEM.U("Alert") ; a beep. If so, call the proc.
ENDIF
ENDPROC
WRITELIB LIBNAME OKWAITPROC.U
RELEASE PROCS OKWAITPROC.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "OkWaitProc.u" )
; ────────────────────────────────────────────────────────────────────────────
; Procedure: YesNo.l()
; Description: Displays a dialog box with a user-defined message (usually
; a question) and two pushbuttons labeled "Yes" and "No." The
; message can be one or several lines long. The procedure
; stops whatever process is underway and waits for the user
; make a decision.
; Syntax: YesNo.l(Title.a, Message.a, Frame.l, Beep.l)
; Arguments: Title.a: Title.a is a character string containing the
; title of the dialog box, which Paradox centers on the
; top of the window frame.
; Message.a: Message.a is a character string expression
; which is displayed as a message above the pushbutton. It
; can be more than one line. Each line is separated by the
; "/" character. (See examples below.)
; Frame.l: Frame.l is a logical (True/False) expression which
; indicates that the message is displayed within an inter-
; ior GUI frame. "True" indicates that the proc should use
; a frame; "false" indicates that it should not.
; Beep.l: Beep.l is a logical (True/False) expression which
; indicates that a "beep" should accompany the display of
; the dialog box. "True" indicates yes; "False," no.
; Return Value: YesNo.l returns logical True of the user pressed [Yes] and
; logical False is the user pressed [No].
; Usage: YesNo.l is used whenever you need to get a decision from the
; the user before continuing. For example, it could be
; called before backing up a table.
; Example: YesNo.l("Alert", "Ready to backup up database files?",
; True, True)
;────────────────────────────────────────────────────────────────────────────
PROC YESNO.L(TITLE.A, MESSAGE.A, FRAME.L, BEEP.L)
PRIVATE MSGSEG.A, ; Unparsed message segment
LENGTH.N, ; length of longest line
NLINES.N, ; number of message lines
MSG.A, ; Placeholder for Match()
SROW.N, ; Starting row
SCOL.N, ; Starting column
CTRFORMAT.A ; Format for centering text
PROCNAME.A = "YesNo.l" ; Note the proc name in case we
; encounter an error.
ECHO OFF ; "Turn out the lights."
MSGSEG.A = MESSAGE.A ; Initialize variables
LENGTH.N = 0
NLINES.N = 1
WHILE MATCH(MSGSEG.A, "../.." , ; Determine how many lines there
MSG.A, MSGSEG.A) ; are and how long the longest
LENGTH.N = MAX(LENGTH.N, LEN(MSG.A)) ; one is.
NLINES.N = NLINES.N + 1
ENDWHILE
LENGTH.N = MAX(LENGTH.N, LEN(MSGSEG.A)) ; The last line won't run through
; the above loop, so we have to
; compare its length against the
; longest line so far.
LENGTH.N = MAX(LENGTH.N, 17) ; Make sure the box is big enough
; to accomodate buttons.
LENGTH.N = MIN(LENGTH.N, 72) ; Make sure the longest line is
; not longer than 72 characters.
IF FRAME.L THEN ; Add padding to line length to
LENGTH.N = LENGTH.N + 8 ; allow for dialog box frame,
NLINES.N = NLINES.N + 7 ; interior frame, and button.
ELSE
LENGTH.N = LENGTH.N + 6 ; If there's no interior frame,
NLINES.N = NLINES.N + 6 ; then we can reduce the overall
; size of the dialog box.
ENDIF
SROW.N= 12 - INT(NLINES.N / 2) ; Determine starting row.
SCOL.N = 40 - INT(LENGTH.N / 2) ; Determine starting col.
CTRFORMAT.A = "W" + ; Set up format variable that
STRVAL(LENGTH.N - 6) + ", ac" ; centers screen in width.
SHOWDIALOG
TITLE.A ; Display the dialog box.
PROC "YesNoWaitProc.u" ; Specify the WaitProc to call
TRIGGER "Open" ; the "Open" trigger is generated.
@SROW.N, SCOL.N
HEIGHT NLINES.N WIDTH LENGTH.N ; Dialog box coordinates.
PUSHBUTTON @NLINES.N - 4, ; [Yes] Pushbutton
INT((LENGTH.N / 2) - 10)
WIDTH 9
"~Y~es"
OK
DEFAULT ; The default button (duh!)
VALUE "Yes"
TAG "YesTag"
TO BUTTONVALUE.A
PUSHBUTTON @NLINES.N - 4, ; [No] Pushbutton
INT(LENGTH.N / 2)
WIDTH 9
"~N~o"
CANCEL
VALUE "No"
TAG "NoTAG"
TO BUTTONVALUE.A
ENDDIALOG
RETURN RETVAL
ENDPROC
WRITELIB LIBNAME YESNO.L
RELEASE PROCS YESNO.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "YesNo.u" )
; ────────────────────────────────────────────────────────────────────────────
; This proc is called by the ShowDialog command in YesNo.l(). It follows the
; standard WaitProc format.
; ────────────────────────────────────────────────────────────────────────────
PROC YESNOWAITPROC.U(TRIGGERTYPE.A, TAGVALUE.A, EVENTRECORD.Y, CYCLE.N)
PRIVATE LASTLINE.A, ; Lastline of message.
ELLIPSES.N ; Placeholder for ellipses search
PROCNAME.A = "YesNoWaitProc.u" ; Note the proc name in case we
; encounter an error.
WINDOW HANDLE DIALOG TO YESNO.H ; Give this dialog box a handle.
SETCANVAS YESNO.H ; Set the canvas to the dialog
; box, so that we can write to it.
CANVAS OFF ; Turn the canvas off while we
; draw the message and frame.
STYLE ATTRIBUTE SYSCOLOR(1036) ; Use the default background text
; for Dialog boxes.
IF FRAME.L THEN ; See if the user wants an inter-
FRAME SINGLE ; ior frame; if so, draw it.
FROM 0, 1 TO NLINES.N - 6,
LENGTH.N - 4
; Now paint the frame--GUI-style.
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Top line of frame box.
0, 1, 0, LENGTH.N - 5
PAINTCANVAS ATTRIBUTE SYSCOLOR(1032) ; Left line of frame box.
0, 1, NLINES.N - 6, 1
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Right line of frame box.
0, LENGTH.N - 4,
NLINES.N - 6, LENGTH.N - 4
PAINTCANVAS ATTRIBUTE SYSCOLOR(1036) ; Bottom line of frame box.
NLINES.N - 6, 2,
NLINES.N - 6, LENGTH.N - 5
ENDIF
MSGSEG.A = MESSAGE.A ; Re-initialize variables.
SROW.N= 1
SCOL.N = 2
WHILE MATCH(MSGSEG.A, "../.." , ; Parse the message, and paint
MSG.A, MSGSEG.A) ; the canvas, one line at a time.
@ SROW.N, SCOL.N
?? FORMAT(CTRFORMAT.A, MSG.A)
SROW.N= SROW.N + 1 ; Move down one row.
ENDWHILE
LASTLINE.A = FORMAT(CTRFORMAT.A, ; Format the last line.
MSGSEG.A)
@ SROW.N, SCOL.N ?? LASTLINE.A ; Put it on the canvas.
ELLIPSES.N = SEARCH("...", LASTLINE.A) ; Check for ellipses.
IF ELLIPSES.N > 0 THEN ; If there's an ellipses, then
STYLE ATTRIBUTE SYSCOLOR(1036) + 128 ; paint it with the blinking
@ SROW.N, ; attribute.
SCOL.N + ELLIPSES.N - 1 ?? "..."
ENDIF
CANVAS ON ; Display the completely-drawn
; message.
IF BEEP.L THEN ; Check to see if the user wants
BEEPEM.U("Alert") ; a beep. If so, call the proc.
ENDIF
ENDPROC
WRITELIB LIBNAME YESNOWAITPROC.U
RELEASE PROCS YESNOWAITPROC.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "YesNoWaitProc.u" )
; Taken from Paradoc 4.0 Developer's Guide
; ---------------------------------------------------------------------------
; Proc name : ShowAboutBox()
; Purpose : Produces an "about" dialog box on demand
; Returns : *None*
; Comments : Uses global dynarray "SystemInfo" for window dimensions
; Adapted from Greaves and Lindsay Paradox 4 Developers Guide
; ---------------------------------------------------------------------------
PROC SHOWABOUTBOX()
SYSINFO TO INFOBAG
SHOWDIALOG
"About"
PROC "RepaintProc"
IDLE
@4,17 HEIGHT 17 WIDTH 45
STYLE ATTRIBUTE 15+16
@1,0 ?? FORMAT("W43,AC", "Moose and Squirrel Software" )
STYLE ATTRIBUTE 112
@3,0 ?? FORMAT("W43,AC", "CopyRight 1992-93 James Cap'n Walker" )
@4,0 ?? FORMAT("W43,AC", "Portions Copyrighted by Kallista, Inc." )
@5,0 ?? FORMAT("W43,AC", "and Weston Brother Software 1991-92" )
FRAME FROM 6,1 TO 6,41
@7,0 ?? FORMAT("W43,AC", FORMAT("D2", TODAY()) + " " + TIME())
@8,0 ?? FORMAT("W43,AC", "Mouse is" + IIF(INFOBAG["MOUSE"], " " , " not " ) + "Installed" )
@10,4 ?? "Available Expanded Memeory : " + STRVAL(INFOBAG["EXPANDED"])
@11,4 ?? "Available Extended Memeory : " + STRVAL(INFOBAG["EXTENDED"])
PUSHBUTTON @13,16 WIDTH 10
"OK"
OK
VALUE "OK"
TAG "OKTag"
TO PBUTTONVAL
ENDDIALOG
ENDPROC
WRITELIB LIBNAME SHOWABOUTBOX
RELEASE PROCS SHOWABOUTBOX
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ShowAboutBox" )
PROC REPAINTPROC(EVENTTYPE, TAGVALUE, EVENTVALUE, ELEMENTVALUE)
REPAINTDIALOG
RETURN TRUE
ENDPROC
WRITELIB LIBNAME REPAINTPROC
RELEASE PROCS REPAINTPROC
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "RepaintProc" )
;This file is copyright (c) 1992, Informant Communications Group and the
;article author. The material here may be used in an application provided
;that this copyright/disclaimer information is kept in the original source
;file. The material presented here is provided "as is" and with no guarantee.
;Informant Communications Group/Paradox Informant assumes no responsibility
;for the use or misuse of the material contained within.
;
;Contents : Source file GUIBUTON.SC
;Author : Tony Goodman - Ensemble Corporation
;Informant Issue : August 1992
;Description : Buttons in a Wait Proc by ENSEMBLE CORPORATION
;
; Paradox Informant
; 10519 E. Stockton Blvd.
; Suite 142
; Elk Grove, CA 95624-9743
; Phone: (916) 686-6610
; Fax : (916) 686-8497
; BBS : (916) 686-4740
;-----------------------------------------------------------------------------
; Buttons in a Wait Proc by ENSEMBLE CORPORATION
;Createlib "ENSEMBLE"
PROC BUTTON_OBJECTS(BUTTONDYN)
PRIVATE I,WINATTRIB,SYSTEMINFO,WINHANDLE
SYSINFO TO SYSTEMINFO ;We will want to know the Screen Height
DYNARRAY WINATTRIB[] ;Initalize Button Window Attributes
WINATTRIB["HasFrame"]=FALSE ;Remove the frame
WINATTRIB["HasShadow"]=FALSE ;3D GUI Buttons Look best with no shadow
WINATTRIB["Style"]=127 ;Canvas Color for button Text
WINATTRIB["Height"]=3 ;Button Height
WINATTRIB["CanvasHeight"]=3 ;Ditto
WINATTRIB["Width"]=8 ;Button Width (Up to 10 buttons will fit)
WINATTRIB["CanvasWidth"]=8 ;Ditto
WINATTRIB["OriginCol"]=(80 - DYNARRAYSIZE(BUTTONDYN)*WINATTRIB["Width"])/2
;Left Column Button Panel
WINATTRIB["OriginRow"]=SYSTEMINFO["ScreenHeight"]-3
;Place buttons near bottom of screen
FOREACH I IN BUTTONDYN
;Attach Button Method to Button via the Title Attribute;
;The title actually becomes a miniscript to be executed.
WINATTRIB["Title"]=BUTTONDYN[i]+" ;METHOD" ;Method Identifier
WINDOW CREATE FLOATING
ATTRIBUTES WINATTRIB
TO WINHANDLE
GUIFRAME(WINHANDLE,"Out") ;Make a button look like a button
;Button Lable Text
@ 1,1 ?? FORMAT("W"+STRVAL(WINATTRIB["Width"]-2)+",AC",I)
;Increment Origin Column for the next button
WINATTRIB["OriginCol"]=WINATTRIB["OriginCol"]+WINATTRIB["Width"]
ENDFOREACH
ENDPROC
WRITELIB LIBNAME BUTTON_OBJECTS
RELEASE PROCS BUTTON_OBJECTS
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Buttom_Objects" )
PROC GUIFRAME(WINHANDLE,IN_OUT)
PRIVATE COLOR1,COLOR2,WINATTRIB,H,W
IF IN_OUT="Out" THEN
COLOR1=112 COLOR2=127
ELSE
COLOR1=127 COLOR2=112
ENDIF
WINDOW GETATTRIBUTES WINHANDLE TO WINATTRIB
H=WINATTRIB["CanvasHeight"]
W=WINATTRIB["CanvasWidth"]
;Draw The GUI Frame
SETCANVAS WINHANDLE
FRAME SINGLE FROM 0,0 TO H-1, W-1
PAINTCANVAS ATTRIBUTE COLOR2 0, 0, H-1, W-1
PAINTCANVAS ATTRIBUTE COLOR1 H-1, 1, H-1, W-2
PAINTCANVAS ATTRIBUTE COLOR1 0, W-1, H-1, W-1
ENDPROC
WRITELIB LIBNAME GUIFRAME
RELEASE PROCS GUIFRAME
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "GUIFrame" )
PROC BUTTON_METHODS(TRIGGERTYPE,EVENTRECORD,CYCLENUMBER)
PRIVATE WINHANDLE,WINATTRIB
;Check to see if the mouse is clicking on a button Window
WINHANDLE=WINDOWAT(EVENTRECORD["Row"],EVENTRECORD["Col"])
IF WINHANDLE >0 THEN
WINDOW GETATTRIBUTES WINHANDLE TO WINATTRIB
IF MATCH(WINATTRIB["Title"],"..;METHOD") THEN
GUIFRAME(WINHANDLE,"In")
IF EVENTRECORD["Action"]="DOWN" THEN
SLEEP 100
ENDIF
GUIFRAME(WINHANDLE,"Out")
EXECUTE WINATTRIB["Title"] ;Execute Button Method
IF ISASSIGNED(RETVAL) AND
(RETVAL=1 OR RETVAL=2 OR RETVAL=0) THEN
RETURN RETVAL ;Return a 0 or 1 or 2
ELSE
RETURN 1 ;Return to Wait
ENDIF
ENDIF
ENDIF
RETURN 0 ;Process the Mouse event normally
ENDPROC
WRITELIB LIBNAME BUTTON_METHODS
RELEASE PROCS BUTTON_METHODS
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "Button_Methods")
PROC BACKUPMANAGER();---------------------------------------------------
;This procedure is Copyrighted (c) 1993 JRN Enterprises, but may be distributed
;freely as SHAREWARE. No fees or royalties are required by the author.
;
;This procedure was developed to provide an easy way to incorporate a
;backup function into any application. This is a common request among many
;users, and this utility will fill that need.
;
;The procedure has been soley developed and created by JRN Enteprises.
;This procedure may be copied and improved. This procedure
;may also be distributed with applications all long as this statement is
;included.
;
;Please pass any improvements to the author. Merely changing such code herein
;does not entitle one to the rights of this code.
;
;02/04/93 JRN ENTERPRISES
; John R. Nelson
; 110 W. Marley Lane
; Simpsonville, SC 29681
; COMPUSERVE ID: 70641,3562
; PRODIGY ID: RPJH51A
;VARIABLES
PRIVATE
BACKUPSTRING, ;what will be used to perform the backup
PATH, ;the path to backup to
NOCURPATH, ;dummy variable testing for the current path
BUTTONVALUE, ;used in all of the dialog boxes
DRVSIZE, ;what size disk will be formatted
MSG, ;dialog messages of any length
F, ;length of generic messages
TIME.A, ;the time to use for backing up with the /t switch
RETVAL, ;system variable
DATE1.D, ;the date to use for backing up with the /d switch
DRV, ;the drive to back up to
CURPATH, ;the path to backup from
BACKUPOPTS, ;the array for the backup switches
CHECKBOX, ;the array for the checkboxes for backupopts
A, ;length of generic dialog message
BACKUPPATH ;the path to backup to
CURPATH=DIRECTORY() ;get the current path
BUTTONVALUE="Cancel" ;initialize
;set up an array for the radio buttons. These are the options that are
;shown in any DOS book.
ARRAY BACKUPOPTS[7]
BACKUPOPTS[1]="/s Include subdirectories"
BACKUPOPTS[2]="/m files changed since last BU"
BACKUPOPTS[3]="/a Add files to those on BU disk"
BACKUPOPTS[4]="/f Format target disk"
BACKUPOPTS[5]="/d Only files modified after date"
BACKUPOPTS[6]="/t Only files modified after time"
;BEWARE!! An error seemed to occur every time that I tried to make a log
;file. That is why it is not included.
; BackupOpts[7]="/L Make log entry in specified file" ;left this out
;for ease
;Array for the checkboxes themselves. Checkbox 1 and 4 will already
;be marked when the user arrives
ARRAY CHECKBOX[7]
CHECKBOX[1]=TRUE
CHECKBOX[4]=TRUE
;lets show the dialog box that the user will see
SHOWDIALOG "Backup Manager" ;box title
@3,3 HEIGHT 18 WIDTH 76 ;position and size
@2,2 ??"Current Path: " ;information about where we are when
ACCEPT @3,4 WIDTH 25 ;starting
"A23"
TAG "curpathtag"
TO CURPATH
@8,2 ?? "Backup Drive: " ;description of radio buttons
RADIOBUTTONS @9,5 HEIGHT 3 WIDTH 10
"A",
"B",
"C"
TAG "DrvTag"
TO DRV
STYLE ATTRIBUTE 126 ;yellow on gray description to show the
@1,44 ?? "Backup Options" ;checkboxes
CHECKBOXES @2,33 HEIGHT 7 WIDTH 40
TAG "Check"
BACKUPOPTS[1] TO CHECKBOX[1],
BACKUPOPTS[2] TO CHECKBOX[2],
BACKUPOPTS[3] TO CHECKBOX[3],
BACKUPOPTS[4] TO CHECKBOX[4],
BACKUPOPTS[5] TO CHECKBOX[5],
BACKUPOPTS[6] TO CHECKBOX[6]
; BackupOpts[7] TO Checkbox[7] ;commented out because it
;is not included
PUSHBUTTON @14,15 WIDTH 10
"OK"
OK
DEFAULT
VALUE "Accept"
TAG "AcceptTag"
TO BUTTONVALUE
PUSHBUTTON @14,40 WIDTH 10
"Cancel"
CANCEL
VALUE "Cancel"
TAG "CancelTag"
TO BUTTONVALUE
ENDDIALOG
IF BUTTONVALUE="Accept" THEN ;the user chose to continue!!
NOCURPATH=TRUE ;dummy var. to see if the surrent path
;exists
IF DIREXISTS(CURPATH)=0 THEN ;does it exist?
;NO!!
MSG="Directory "+CURPATH+" does not exist"
A=LEN(MSG)+10 ;get the length of the message and
;add 5 spaces to it
F=A ;set f
IF F<30 THEN ;make sure we have a big enough box
F=30
ENDIF
;a dialog box to give the user a chance to know that the current path does
;not exist
SHOWDIALOG "Directory Message" ;Initiate a SHOWDIALOG box
@8,INT(41-F/2) HEIGHT 7 WIDTH F
;on length of message
@1,4 ?? MSG ;print the message
PUSHBUTTON @3,INT(F/2)-6 WIDTH 10;Acknowledgment pushbutton
"OK"
OK
DEFAULT
VALUE "Yes"
TAG "ACCEPT"
TO BUTTONVALUE
ENDDIALOG
NOCURPATH=FALSE ;the current path did not
;exist set the value to FALSE
ENDIF
IF NOCURPATH THEN ;if the current path does exist
;then keep going
SWITCH ;change the radio buttons
CASE DRV=1: ;to drive letters that are
DRV="A:" ;usable as switches
CASE DRV=2:
DRV="B:"
CASE DRV=3:
DRV="C:"
ENDSWITCH
BUTTONVALUE="Accept" ;initialize
WHILE TRUE ;set up a loop to check the
;backup drive
IF DRIVESTATUS(SUBSTR(DRV,1,1))=FALSE THEN ;is the drive ready?
BUTTONVALUE="Cancel" ;NO!!!
MSG="Drive "+DRV+" is not ready, please correct the error."
A=LEN(MSG)+10 ;get the length of the message and
;add 5 spaces to it
F=A ;set f
IF F<30 THEN ;Make the boz big enough
F=30
ENDIF
SHOWDIALOG "Drive Message" ;Initiate a SHOWDIALOG box to give the
;user a chance to reset the drive
@8,INT(41-F/2) HEIGHT 7 WIDTH F
;on length of message
@1,4 ?? MSG ;print the message
PUSHBUTTON @3,INT(F/2)-16 WIDTH 10;Acknowledgment pushbutton
"Retry"
OK
DEFAULT
VALUE "Retry"
TAG "ACCEPT"
TO BUTTONVALUE
PUSHBUTTON @3,INT(F/2)+6 WIDTH 10;Cancel pushbutton
"Cancel"
CANCEL
VALUE "Cancel"
TAG "CANCEL"
TO BUTTONVALUE
ENDDIALOG
IF BUTTONVALUE="Cancel" THEN ;the user decided not to go on
QUITLOOP
ENDIF
ELSE ;the drive was ready to start with
QUITLOOP
ENDIF
ENDWHILE
IF BUTTONVALUE<>"Cancel" THEN ;OK, we are still going. the user made
;it through the drive test.
BACKUPPATH=DRV ;set up the backup path
IF BUTTONVALUE<>"Cancel" THEN ;OK, the path exists
BACKUPSTRING="BACKUP "+CURPATH+" "+BACKUPPATH ;we will now set the backup string
IF CHECKBOX[1]=TRUE THEN ;did the user select the 's' switch?
BACKUPSTRING=BACKUPSTRING+" /s" ;add it to the backup string
ENDIF
IF CHECKBOX[2]=TRUE THEN ;did the user select the 'm' switch
BACKUPSTRING=BACKUPSTRING+" /m" ;add it to the backup string
ENDIF
IF CHECKBOX[3]=TRUE THEN ;did the user select the 'a' switch
BACKUPSTRING=BACKUPSTRING+" /a" ;add it to the backup string
ENDIF
IF CHECKBOX[4]=TRUE THEN ;did the user select the 'f' switch
BUTTONVALUE="Cancel" ;we will initialize like Cancel
SHOWDIALOG "Backup Manager Disk Size" ;box title
@3,15 HEIGHT 16 WIDTH 50 ;position and size
@1,10 ?? "Specify the backup disk type:"
RADIOBUTTONS @3,5 HEIGHT 7 WIDTH 40
"160K single-sided 5.25 inch disk",
"180K single-sided 5.25 inch disk",
"320K double-sided 5.25 inch disk",
"360K double-sided 5.25 inch disk",
"1.2M double-sided 5.25 inch disk",
" 720K double-sided 3.5 inch disk",
" 1.44M double-sided 3.5 inch disk"
TAG "Drvsize"
TO DRVSIZE
PUSHBUTTON @12,10 WIDTH 10
"OK"
OK
DEFAULT
VALUE "Accept"
TAG "AcceptTag"
TO BUTTONVALUE
PUSHBUTTON @12,30 WIDTH 10
"Cancel"
CANCEL
VALUE "Cancel"
TAG "CancelTag"
TO BUTTONVALUE
ENDDIALOG
IF BUTTONVALUE<>"Cancel" THEN ;did they choose cancel?
SWITCH ;no, so convert the radiobuttons
CASE DRVSIZE=1: ;to something meaningful.
DRVSIZE=160
CASE DRVSIZE=2:
DRVSIZE=180
CASE DRVSIZE=3:
DRVSIZE=320
CASE DRVSIZE=4:
DRVSIZE=360
CASE DRVSIZE=5:
DRVSIZE=720
CASE DRVSIZE=6:
DRVSIZE=1200
CASE DRVSIZE=7:
DRVSIZE=1440
ENDSWITCH
BACKUPSTRING=BACKUPSTRING+" /f:"+STRVAL(DRVSIZE) ;add this to the backupstring
ENDIF
ENDIF
IF BUTTONVALUE<>"Cancel" THEN ;ensure that cancel has not been chosen
IF CHECKBOX[5]=TRUE THEN ;do they want to backup since a date?
DATE1.D=1/1/90 ;set default variable values
BUTTONVALUE="Cancel"
;show a dialog box that will allow the user to enter the dates in an
;easy manner
SHOWDIALOG "Date entry"
@5,15 HEIGHT 8 WIDTH 53
@2,2 ?? "Enter the date to backup from: "
ACCEPT @2,33
WIDTH 10 "D"
MIN 1/1/90
MAX TODAY()
REQUIRED
TAG "Date1"
TO DATE1.D
PUSHBUTTON @4,5 WIDTH 10
"~O~K"
OK
VALUE "Accept"
TAG "Yes"
TO BUTTONVALUE
PUSHBUTTON @4,35 WIDTH 10
"~C~ANCEL"
CANCEL
VALUE "Cancel"
TAG "No"
TO BUTTONVALUE
ENDDIALOG
IF BUTTONVALUE<>"Cancel" THEN ;add the date to the backup string
BACKUPSTRING=BACKUPSTRING+" /d:"+STRVAL(DATE1.D)
ENDIF
ENDIF
IF BUTTONVALUE<>"Cancel" THEN ;what about a time?
IF CHECKBOX[6]=TRUE THEN
TIME.A="00:00" ;set default variable values
BUTTONVALUE="Cancel"
;show a dialog box that will allow the user to enter the dates in an
;easy manner
SHOWDIALOG "Time entry"
@5,15 HEIGHT 8 WIDTH 53
@2,2 ?? "Enter the time to backup from: "
ACCEPT @2,33
WIDTH 8 "A5"
PICTURE "{0#,1#,2{0,1,2,3}}:{0,1,2,3,4,5}#"
REQUIRED
TAG "timea"
TO TIME.A
PUSHBUTTON @4,5 WIDTH 10
"~O~K"
OK
VALUE "Accept"
TAG "Yes"
TO BUTTONVALUE
PUSHBUTTON @4,35 WIDTH 10
"~C~ANCEL"
CANCEL
VALUE "Cancel"
TAG "No"
TO BUTTONVALUE
ENDDIALOG
IF BUTTONVALUE<>"Cancel" THEN ;add the time to the string
BACKUPSTRING=BACKUPSTRING+" /t:"+TIME.A
ENDIF
ENDIF
IF BUTTONVALUE<>"Cancel" THEN ;Lets backup
BEEPEM.U("ILLEGAL")
MESSAGE "Executing backup command: "
SLEEP 500
MESSAGE BACKUPSTRING
SLEEP 2000
RUN NOSHELL BACKUPSTRING
IF RETVAL <> -1 THEN
BEEPEM.U("ERROR")
MESSAGE "Backup command executed!!"
SLEEP 2000
ELSE
OK.U("Backup Problem", "BACKUP FAILED!//Backup Command may not be on your path...",TRUE,TRUE)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDPROC;---------------------------------------------------------------
WRITELIB LIBNAME BACKUPMANAGER
RELEASE PROCS BACKUPMANAGER
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "BackUpManager")
;This file is copyright (c) 1992 Informant Communications Group and the
;article author. The material here may be used in an application provided
;that this copyright/disclaimer information is kept in the original source
;file. The material presented here is provided "as is" and with no guarantee.
;Informant Communications Group/Paradox Informant assume no responsibility
;for the use or misuse of the material contained within.
;
;Contents : procedures inErrorHandler.n(),
; inErrorLog.u(),
; msAlertDialog.u(),
; msConfirm.l(),
; msContinue!.u(),
; msShortcuts.a(),
; msWorking.u(),
; msWorkingClear.u(),
; quExecute.l()
;
;Source File : ERRUTIL1.SC
;Author : Dan Paolini
; DataStar International
; dp Solutions
;
;Informant Issue : November 1992
;
;Description : Error-handling procedures
;
; Paradox Informant
; 10519 E. Stockton Blvd.
; Suite 142
; Elk Grove, CA 95624-9743
; Phone: (916) 686-6610
; Fax : (916) 686-8497
; BBS : (916) 686-4740
; ============================================================================
; TITLE: msWorkingClear.u (c) 1991 - 1993 DataStar International
; RETURNS: No value
; DESCRIPTION: Generic Information Message Window Clearer
; ----------------------------------------------------------------------------
PROC MSWORKINGCLEAR.U() ; Clears msWorking message
PRIVATE OLDWINDOW.H,
OLDCANVAS.H
;Global g.message.h
OLDWINDOW.H = GETWINDOW()
OLDCANVAS.H = GETCANVAS()
IF ISASSIGNED(G.MESSAGE.H) AND ISWINDOW(G.MESSAGE.H) THEN
WINDOW SELECT G.MESSAGE.H
WINDOW CLOSE
ENDIF
IF ISWINDOW(OLDCANVAS.H) THEN
SETCANVAS OLDCANVAS.H
ELSE
SETCANVAS DEFAULT
ENDIF
IF ISWINDOW(OLDWINDOW.H) THEN
WINDOW SELECT OLDWINDOW.H
ENDIF
RETURN
ENDPROC
WRITELIB LIBNAME MSWORKINGCLEAR.U
RELEASE VARS MSWORKINGCLEAR.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msWorkingClear.u")
; ============================================================================
; TITLE: msWorking.u (c) 1991 - 1993 DataStar International
; RETURNS: No value
; DESCRIPTION: Generic Information Message Window, Cleared as follows:
; 0 Seconds - must be manually cleared
; 1 - 5 Seconds - self-clears
; -1 Seconds - pauses while event = IDLE, then clears
; ----------------------------------------------------------------------------
PROC MSWORKING.U( ; Generic information message window
MESSAGE.A, ; Message to display (<ScreenWidth
COLOR.N, ; Color for message window
BEEP.N, ; Number of beeps
SLEEP.N) ; # of Seconds to pause (-1 to 5)
PRIVATE Y, N,
WIDTH.N,
OLDCANVAS.H,
OLDWINDOW.H,
OFFSET.N
;Global g.message.h
; g.sysinfo.y
IF LEN(MESSAGE.A) = 1 THEN
MESSAGE.A = MSSHORTCUTS.A(MESSAGE.A)
ENDIF
MESSAGE.A = MESSAGE.A + "..."
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y ; Determine Screen Size
ENDIF
MSWORKINGCLEAR.U()
DYNARRAY Y[]
Y["CanClose"] = FALSE
Y["CanMaximize"] = FALSE
Y["CanMove"] = FALSE
Y["CanResize"] = FALSE
Y["HasFrame"] = FALSE ; If Framed, window is *5* rows!!!
Y["Style"] = COLOR.N
WIDTH.N = MAX(50,MIN(LEN(MESSAGE.A)+4,G.SYSINFO.Y["ScreenWidth"]-4))
OFFSET.N = MAX(5,INT((WIDTH.N-LEN(MESSAGE.A)+1)/2)+3)
OLDCANVAS.H = GETCANVAS()
OLDWINDOW.H = GETWINDOW()
WINDOW CREATE FLOATING @ -200,-200
HEIGHT 1 WIDTH WIDTH.N
ATTRIBUTES Y TO G.MESSAGE.H
STYLE ATTRIBUTE COLOR.N
PAINTCANVAS FILL FORMAT("w"+STRVAL(WIDTH.N)+",ac",MESSAGE.A) ATTRIBUTE COLOR.N 0,0,0,WIDTH.N-1
PAINTCANVAS ATTRIBUTE COLOR.N + 128 0,WIDTH.N - OFFSET.N,0,WIDTH.N-OFFSET.N+2
WINDOW MOVE G.MESSAGE.H TO 1, INT((G.SYSINFO.Y["ScreenWidth"]-WIDTH.N)/2)
FOR N FROM 1 TO MIN(5,BEEP.N)
BEEP SLEEP 100 ; Beep for desired # of Beeps
ENDFOR
SWITCH
CASE SLEEP.N > 0 :
SLEEP MIN(SLEEP.N,5) * 1000 ; Sleep for desired # of seconds
WINDOW SELECT G.MESSAGE.H
WINDOW CLOSE
CASE SLEEP.N < 0 :
MESSAGE "Mouseclick or Press Any Key to Continue..."
WHILE TRUE
GETEVENT ALL TO Y
IF (Y["Type"] = "MOUSE" AND Y["Action"] = "DOWN") OR
Y["Type"] = "KEY" THEN
QUITLOOP
ENDIF
ENDWHILE
WINDOW SELECT G.MESSAGE.H
WINDOW CLOSE
ENDSWITCH
IF ISWINDOW(OLDCANVAS.H) THEN
SETCANVAS OLDCANVAS.H
ELSE
SETCANVAS DEFAULT
ENDIF
IF ISWINDOW(OLDWINDOW.H) THEN
WINDOW SELECT OLDWINDOW.H
ENDIF
RETURN
ENDPROC
WRITELIB LIBNAME MSWORKING.U
RELEASE VARS MSWORKING.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msWorking.u")
;===========================================================================
; AUTHOR: Copyright (c) 1992 - Daniel J. Paolini II
; DataStar International
; dp Solutions
; CREATED: 09-21-92 04:03 am Version 4.03
;
; TITLE: inErrorHandler.n (c) 1991 - 1993 DataStar International
; RETURNS: Error Continuation Code
; DESCRIPTION: Main Error Handling Procedure - calls inErrorLog.u
; The initial switch deals with specific errors, and attempts
; to continue the application. You should do this only when
; you are sure it won't end up breaking something else (e.g.
; If you continue from a query error, and later code expects
; that the query will have performed successfully, you are
; just postponing the inevitable. That is one reason to use a
; Query Execute procedure, so that you can interrupt the
; process in the event of an error.
; ----------------------------------------------------------------------------
PROC INERRORHANDLER.N() ; Main Error Handler
PRIVATE ERRORPROC, ; Keeps errorproc from being recursive
ERROR.Y, ; DynArray from ErrorInfo
MESSAGE.A, ; Formatted message to user
SCRIPT.A, ; Concatonated re-named Savevars.sc
ERRORWIN.A, ; Paradox Window()
A, ; Counter for FOREACH command
WINDOWS.R, ; Array of Windows from WINDOW LIST
N1, N2 ; Transient Loop Counters
;Global g.sysinfo.y ; System info dynarray
; g.debug.l ; Development DEBUG flag
; g.y ; Dynarray of Passwords
; g.startmemleft.n ; Memory at Startup
; error.l ; Error flag passed back to routine
ERRORWIN.A = WINDOW() ; Capture the Paradox Window
IF NIMAGES() > 0 AND IMAGETYPE() <> "Query" THEN
SETBATCH OFF ; Just in case
ENDIF
ERRORINFO TO ERROR.Y ; Capture the error info bag
RETVAL.N = 2 ; Initialize returned value
SWITCH
CASE ERROR.Y["Proc"] = "WSDITTO.U" :
MSCONTINUE!.U("","You cannot ditto " + STRVAL(RECORD.R[Field()]) +
" - " + ERRORWIN.A,79,"RED",1)
RETVAL.N = 1 ; Ignore Ditto
CASE ERROR.Y["Proc"] = "WSFIELDVIEW.U" AND ERROR.Y["Code"] = 23 :
MSCONTINUE!.U("","The Field Value does not satisfy current validity " +
"checks. Current field value is: " +
STRVAL([]),30,"BLUE",1)
ERROR.L = TRUE ; Set error flag
RETVAL.N = 1 ; Step over the []=[] assignment
CASE ERROR.Y["Proc"] = "WSPICKFORM.L" :
ERROR.L = TRUE ; Set error flag
MSCONTINUE!.U("",ERROR.Y["Message"],79,"RED",1)
RETVAL.N = 1
CASE ERROR.Y["Proc"] = "WSCOPYFROMARRAY.U" :
SWITCH
CASE (ERROR.Y["Code"] = 60 AND
MATCH (ERROR.Y["Message"],"..linked fields in ..") OR
MATCH (ERROR.Y["Message"],"..master record is blank..")) OR
(ERROR.Y["Code"] = 23 AND
MATCH(ERROR.Y["Message"],"..value must be provided..")):
RETVAL.N = 1
CASE ERROR.Y["Code"] = 23 AND
MATCH(ERROR.Y["Message"],"..not one of the possible value.."):
WSCOPYFROMARRAYRECOVER.U(ARRAYNAME.A)
ENDSWITCH
CASE ERROR.Y["Code"] = 23
AND IMAGETYPE() = "Query"
AND ERROR.Y["Proc"] = "QUEXECUTE.L" :
A = []
CTRLBACKSPACE ; Eliminate offending expression
MSCONTINUE!.U("","","The invalid query criterion: " + A +
" was deleted from the " + FIELD() + " field," +
" so that the Query could continue.",31,"BLUE",1)
RETVAL.N = 1 ; Skip over error command
CASE ERROR.Y["Code"] = 34
AND SEARCH("procedure",ERROR.Y["Message"]) <> 0 :
SWITCH
CASE SEARCH("!",ERROR.Y["Message"]) <> 0 :
ERROR.L = TRUE
RETVAL.N = 1
CASE SEARCH("help",ERROR.Y["Message"]) <> 0 :
HELPCHOICE.A = "HELP"
HELPMENU.A = "DEFAULT"
RETVAL.N = 0
ENDSWITCH
CASE ERROR.Y["Code"] = 27 ; Using quExecute.l proc
AND IMAGETYPE() = "Query"
AND ERROR.Y["Proc"] = "QUEXECUTE.L" :
ERROR.L = TRUE ; Set Query Error flag
RETVAL.N = 1 ; Skip over error command
CASE ERROR.Y["Code"] = 27 ; Not using quExecute.l proc
AND IMAGETYPE() = "Query" :
MSCONTINUE!.U("","Query Error - " +WINDOW(),79,"RED",3)
RETVAL.N = 1 ; Skip over error command
CASE ERROR.Y["Code"] = 27 :
MSCONTINUE!.U("","Sorry, the Query could NOT be Completed",79,"RED",3)
RETVAL.N = 1 ; Skip over error command
CASE ERROR.Y["Code"] = 43
OR ERROR.Y["Message"] = "Printer not ready" :
IOPRINTERSTATUS.L()
IF RETVAL THEN
RETVAL.N = 0
ELSE
RETVAL.N = 1
ENDIF
CASE ERROR.Y["Proc"] = "INSTARTUP.L"
AND ERROR.Y["Code"] = 11 : ; PrivDir conflict
RETVAL.N = 1
CASE ERROR.Y["Proc"] = "INERRORRESET.U"
AND ERROR.Y["Code"] = 30 : ; ErrorReset
RETVAL.N = 1
ENDSWITCH
IF RETVAL.N = 2 THEN ; Error still not resolved
ECHO OFF
PASSWORD.A = "" ; Deassign any password variables
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y ; Capture System Info
ENDIF
IF G.SYSINFO.Y["UIMode"] = "COMPATIBLE" THEN
CANVAS ON ; Just in case
ENDIF
IF ISASSIGNED(G.Y) THEN ; Deassign any password variables
FOREACH A IN G.Y
UNPASSWORD G.Y[a]
G.Y[a] = "********"
ENDFOREACH
ENDIF
IF ISASSIGNED(G.A) THEN
UNPASSWORD G.A
G.A = "********"
ENDIF
IF ISASSIGNED(T.A) THEN
UNPASSWORD T.A
T.A = "********"
ENDIF
IF ISASSIGNED(CHARS.A) THEN
CHARS.A = "********"
ENDIF
IF NOT MATCH(ERROR.Y["Message"],"..run Error..",A,MESSAGE.A) THEN
IF NOT MATCH(ERROR.Y["Message"],"..Syntax Error..",A,MESSAGE.A) THEN
MESSAGE.A = ERROR.Y["Message"]
ENDIF
ENDIF
MSWORKING.U(MESSAGE.A,79,0,0)
IF NOT ISASSIGNED(G.DEBUG.L) OR NOT G.DEBUG.L THEN
MSCONTINUE!.U("","Error in Procedure: " + ERROR.Y["Proc"] + " - " +
MESSAGE.A,79,"RED",4)
IF DIREXISTS("ERR") = 0 THEN ; Create an ERR directory if none
RUN NOREFRESH "MD ERR" ; Store error logs in separate Dir
ENDIF ; Log the error info
SCRIPT.A = "ERR\\"+STRVAL(TICKS()) ; Easy Unique Name
INERRORLOG.U(ERROR.Y,G.SYSINFO.Y) ; Log the error to disk and printer
MSWORKING.U("Saving Current Variable Assignments to Disk",110,0,0)
SAVEVARS ALL ; Rename Savevars.sc for posterity
IF SYSMODE() <> "Main" THEN
RUN NOREFRESH "REN "+PRIVDIR()+"savevars.sc "+DIRECTORY()+"\\"+SCRIPT.A
ELSE
{Tools} {Rename} {Script} SELECT "Savevars" SELECT SCRIPT.A
IF MENUCHOICE() = "Cancel" THEN ; VERY unlikely
{Replace}
ENDIF
ENDIF
ELSE
MSCONTINUE!.U("","Error in Procedure: " + ERROR.Y["Proc"],79,
"RED",1)
ENDIF
MSWORKINGCLEAR.U() ; Removes message window
IF NOT ISASSIGNED(G.DEBUG.L) OR NOT G.DEBUG.L THEN
MSCONTINUE!.U("","Log Complete - Please Contact Technical Support",
31,"BLUE",1)
RESET
{Tools} {More} {Protect} {Clearpasswords}
SETCOLORS DEFAULT
EXIT
ELSE ; Allow access to DEBUG prompt
MSCONFIRM!.L("","IF <Debug>, Use <Ctrl><T> to Trace Back to Error",79,
"RED",3,"~D~ebug","~C~ancel",TRUE)
IF RETVAL THEN
MSCONFIRM!.L("","Maintain Context, or Display SAVEVARS?",63,
"CYAN",1,"~C~ontext","~S~avevars",TRUE)
IF NOT RETVAL THEN
CANCELDIALOG
WINDOW LIST TO WINDOWS.R
N1 = ARRAYSIZE(WINDOWS.R)
FOR N2 FROM 1 TO N1
IF ISWINDOW(WINDOWS.R[n2]) THEN
WINDOW SELECT WINDOWS.R[n2]
WINDOW CLOSE
ENDIF
ENDFOR
SAVEVARS ALL
EDITOR OPEN PRIVDIR() + "Savevars.sc"
ENDIF
DEBUG ; Must <Ctrl><T> back to error
RETVAL.N = 0
ELSE
RESET
{Tools} {More} {Protect} {Clearpasswords}
SETCOLORS DEFAULT
QUIT "You have Canceled the Application from the Error Prompt..."
ENDIF
ENDIF
ELSE
PROC EPERRORRESET.N() ; Reset the ErrorCode
PRIVATE ERRORPROC
RETURN 1
ENDPROC
ERRORPROC = "epErrorReset.n" ; Specialized errorproc
RETVAL = 1 + "A" ; Create errorcode 30
ERRORPROC = "" ; Deassign errorproc
RELEASE PROCS EPERRORRESET.N ; Release procedure
ENDIF
RETURN RETVAL.N ; 0, 1 or 2
ENDPROC
WRITELIB LIBNAME INERRORHANDLER.N
RELEASE VARS INERRORHANDLER.N
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "inErrorHandler.n")
; ============================================================================
; TITLE: inErrorLog.u (c) 1991 - 1993 DataStar International
; RETURNS: No value
; DESCRIPTION: Error Logging Procedure - called by inErrorHandler.n
; Creates a Memo Variable and writes it to disk from the
; contents of error.y (ErrorInfo, SysInfo & selected info).
; ----------------------------------------------------------------------------
PROC INERRORLOG.U( ; Logs Error to file and printer
ERROR.Y, ; ErrorInfo DynArray
G.SYSINFO.Y) ; SysInfo DynArray
PRIVATE A, ; Tag of error.y in FOREACH loop
ERROR.M ; Memo variable holding errorlog
;Global g.debug.l ; Development DEBUG flag
MSWORKING.U("An Error has occurred, please wait while it is logged",79,3,0)
ERROR.Y["Date of Error"] = TODAY()
ERROR.Y["Working Directory"] = DIRECTORY()
ERROR.Y["Working Drivespace"] = DRIVESPACE(SUBSTR(DIRECTORY(),1,1))
ERROR.Y["Current MemLeft"] = MEMLEFT()
ERROR.Y["Private Directory"] = PRIVDIR()
ERROR.Y["Private Drivespace"] = DRIVESPACE(SUBSTR(PRIVDIR(),1,1))
ERROR.Y["Printer Status"] = FORMAT("LO",PRINTERSTATUS())
ERROR.Y["RunTime"] = FORMAT("LY",ISRUNTIME())
ERROR.Y["Current SysMode"] = SYSMODE()
ERROR.Y["Time of Error"] = TIME()
ERROR.Y["Paradox version"] = VERSION()
ERROR.Y["Paradox Build"] = G.SYSINFO.Y["Build"]
ERROR.Y["Current Extended Memory"] = G.SYSINFO.Y["Extended"]
ERROR.Y["Current Expanded Memory"] = G.SYSINFO.Y["Expanded"]
ERROR.Y["Mouse Available"] = G.SYSINFO.Y["Mouse"]
ERROR.Y["Screen Height"] = STRVAL(G.SYSINFO.Y["ScreenHeight"]) + " Rows"
ERROR.Y["Screen Width"] = STRVAL(G.SYSINFO.Y["ScreenWidth"]) + " Columns"
ERROR.Y["UI Mode"] = G.SYSINFO.Y["UIMode"]
IF NIMAGES() <> 0 THEN ; occurred on image on workspace
ERROR.Y["Number of Images"] = NIMAGES()
ERROR.Y["Current Table"] = TABLE()
ERROR.Y["Current Image Type"] = IMAGETYPE()
ERROR.Y["Current Field"] = FIELD()
IF IMAGETYPE() = "Display" THEN
ERROR.Y["Current Field Value"] = IIF(NIMAGERECORDS() <> 0,[],"No Records Present")
ELSE
ERROR.Y["Current Field Value"] = []
ENDIF
ERROR.Y["Shared Table"] = ISSHARED(TABLE())
IF ERROR.Y["Current Image Type"] = "Query" THEN
IF CHECKMARKSTATUS() <> "" THEN ; store checkmark if appropriate
ERROR.Y["Current Field Value"] = CHECKMARKSTATUS()+" "+[]
ENDIF
ERROR.Y["Formview"] = "N/A"
ERROR.Y["Record Number"] = "N/A"
ELSE
; ERROR.Y["Formview"] = FORMAT("LN",ISFORMVIEW())
ERROR.Y["Record Number"] = RECNO()
ENDIF
ERROR.Y["Number of Records"] = NRECORDS(TABLE())
ELSE ; not in an image
ERROR.Y["Number of Images"] = "N/A"
ERROR.Y["Current Table"] = "N/A"
ERROR.Y["Current Image Type"] = "N/A"
ERROR.Y["Current Field"] = "N/A"
ERROR.Y["Current Field Value"] = "N/A"
ERROR.Y["Shared Table"] = "N/A"
ERROR.Y["Number of Records"] = "N/A"
ERROR.Y["Formview"] = "N/A"
ERROR.Y["Record Number"] = "N/A"
ENDIF
IF ISASSIGNED(G.SYSINFO.Y["Starting MemLeft"]) THEN
ERROR.Y["Starting MemLeft"] = G.SYSINFO.Y["Starting MemLeft"]
ELSE
ERROR.Y["Starting MemLeft"] = "UA"
ENDIF
IF ERROR.Y["User"] = "" THEN
ERROR.Y["User"] = "N/A"
ENDIF
ERROR.M = FILL("-",80) + "\n" +
FORMAT("w80,ac","*** Error while in Procedure " +
ERROR.Y["Proc"] + " ***") + "\n" +
SPACES(8) + "Error: #" + STRVAL(ERROR.Y["Code"]) + " - " +
ERROR.Y["Message"] + "\n" + SPACES(8) + FILL("-",64) + "\n"
FOREACH A IN ERROR.Y
ERROR.M = ERROR.M + FORMAT("w31,ar",A) + ": " + STRVAL(ERROR.Y[a]) + "\n"
ENDFOREACH
; Write memo variable to diskfile
MSWORKING.U("Writing Error Log to Disk",31,0,0)
FILEWRITE APPEND "ERR\\Errorlog.sc" FROM ERROR.M
IF NOT ISASSIGNED(G.DEBUG.L) OR NOT G.DEBUG.L THEN
IF PRINTERSTATUS() THEN ; prints log if printer is available
MSWORKING.U("Writing Error Log to Printer",111,0,0)
OPEN PRINTER
FILEWRITE PRIVDIR()+"Errorlog" FROM ERROR.M
RUN NOREFRESH "Copy "+PRIVDIR()+"Errorlog LPT1 > NUL"
EDITOR NEW PRIVDIR()+"Errorlog"
{Cancel} {Yes}
CLOSE PRINTER
ENDIF
ENDIF
RETURN
ENDPROC
WRITELIB LIBNAME INERRORLOG.U
RELEASE VARS INERRORLOG.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "inErrorLog.u")
; ============================================================================
; TITLE: ioAcceptDialog.v (c) 1991 - 1993 DataStar International
; RETURNS: Value Entered, or false if Cancelled
; DESCRIPTION: Generic routine for accepting data from user, with or without
; a Picture or Default value, Hidden or unhidden.
; ----------------------------------------------------------------------------
PROC IOACCEPTDIALOG.V( ; One value DialogBox Accept
TOP.N, ; Top Row for Box (999 = Centered)
LEFT.N, ; Left Column (999 = Centered)
TITLE.A, ; Title for dBox
PROMPT.A, ; Data Input Prompt
TYPE.A, ; Type of Data Input
PICTURE.A, ; Additional validity string
DEFAULT.V, ; Any Default for the Accept Value?
HIDDEN.L, ; Hidden, or not?
COLORS.Y) ; DynArray of Colors
PRIVATE WIDTH.N, ; Width of Dialog Box
LENGTH.N, ; Length of Input
RIGHT.N, ; Right edge of Box
INPUT.V, ; Value entered by user
OLDCOLORS.Y, ; Previous Color Set
ACCEPT.V, ; Variable to capture Accept
SPOT.N, ; Where to begin Prompt
PBUTTON.A ; Pushbutton variable
;Global g.sysinfo.y
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y ; Determine Screen Size
ENDIF
IF NOT ISASSIGNED(G.APPCOLORS.Y) THEN
GETCOLORS TO G.APPCOLORS.Y
ENDIF
IF G.SYSINFO.Y["UIMode"] = "COMPATIBLE" THEN
ACCEPT.V = IOCANVASACCEPT.V(TOP.N, LEFT.N, 79, PROMPT.A, TYPE.A,
IIF(ISBLANK(PICTURE.A),"",
"Picture \""+PICTURE.A+"\""))
ELSE
IF LEN(PROMPT.A) > 50 THEN ; Must keep to a reasonable length
ACCEPT.V = FALSE
MESSAGE "ERROR - Prompt is too Long!!!"
BEEP BEEP BEEP
SLEEP 5000
ELSE
IF TYPE(COLORS.Y) = "DY" THEN ; Must be a DynArray, or else ignore
SETCOLORS FROM COLORS.Y
ENDIF
SWITCH ; Determine length of Accept Datatype
CASE TYPE.A = "D" : ; Set Default value to passed value
LENGTH.N = 11 ; or a blank value if none passed
ACCEPT.V = IIF(ISBLANK(DEFAULT.V),BLANKDATE(),DEFAULT.V)
CASE TYPE.A = "N" OR TYPE.A = "$" :
LENGTH.N = 20
ACCEPT.V = IIF(ISBLANK(DEFAULT.V),BLANKNUM(),DEFAULT.V)
CASE TYPE.A = "S" :
LENGTH.N = 8
ACCEPT.V = IIF(ISBLANK(DEFAULT.V),BLANKNUM(),DEFAULT.V)
OTHERWISE :
LENGTH.N = NUMVAL(SUBSTR(TYPE.A,2,3)) + 3
ACCEPT.V = DEFAULT.V
ENDSWITCH ; Are we beyond 80 column screen width?
IF LENGTH.N + LEN(PROMPT.A) > 69 THEN
LENGTH.N = 69 - LEN(PROMPT.A)
SPOT.N = 1
ENDIF
WIDTH.N = MIN(74,MAX(32,MAX(LEN(TITLE.A)+10,LENGTH.N+LEN(PROMPT.A)+5)))
IF NOT ISASSIGNED(SPOT.N) THEN ; Calculate starting spot if needed
SPOT.N = INT((WIDTH.N - 3 - LENGTH.N - LEN(PROMPT.A))/2)
ENDIF
IF ISBLANK(PICTURE.A) THEN ; Set "global" Picture if none passed
IF TYPE.A = "D" THEN ; Dates are tricky!
PICTURE.A = "{"+STRVAL(MONTH(TODAY()))+",#[#]}"+"/"+
"{"+STRVAL(DAY(TODAY()))+",#[#]}"+"/"+
"{"+SUBSTR(STRVAL(YEAR(TODAY())),3,2)+",#[#[#[#]]]}"
ELSE
PICTURE.A = "*@"
ENDIF
ENDIF
TOP.N = IIF(TOP.N = 999, INT((G.SYSINFO.Y["ScreenHeight"]-8)/2), TOP.N)
TOP.N = IIF(TOP.N < 0 OR TOP.N > G.SYSINFO.Y["ScreenHeight"]-8, 8, TOP.N)
LEFT.N = IIF(LEFT.N = 999 OR LEFT.N < 0 OR
LEFT.N > G.SYSINFO.Y["ScreenWidth"]-WIDTH.N-3,
INT((G.SYSINFO.Y["ScreenWidth"]-WIDTH.N)/2), LEFT.N)
IF HIDDEN.L THEN
ACCEPT.V = IOACCEPTDIALOGHIDDEN.V(TOP.N, LEFT.N, TITLE.A,
PROMPT.A, TYPE.A, PICTURE.A,
WIDTH.N, SPOT.N, "CANCEL")
ELSE
ACCEPT.V = IOACCEPTDIALOGVALUE.V(TOP.N, LEFT.N, TITLE.A,
PROMPT.A, TYPE.A, PICTURE.A,
WIDTH.N, SPOT.N, "CANCEL")
ENDIF
ENDIF
SETCOLORS FROM G.APPCOLORS.Y
ENDIF
RETURN ACCEPT.V ; Return entered value or FALSE
ENDPROC
WRITELIB LIBNAME IOACCEPTDIALOG.V
RELEASE VARS IOACCEPTDIALOG.V
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "ioAcceptDialog.v")
; ============================================================================
; TITLE: msConfirm!.l (c) 1991 - 1993 DataStar International
; RETURNS: Logical true/false if User Confirmed/Canceled
; DESCRIPTION: Generic Continue-or-Cancel Message routine
; Alert 0 = No sound
; Alert 1 = Three beeps
; Alert 2 = Siren, short (high-low-high-low-high)
; Alert 3 = Two beeps, continuous
; Alert 4 = Two high beeps, two low beeps, continuous
; Alert 5 = Siren, continuous
; ----------------------------------------------------------------------------
PROC MSCONFIRM!.L( ; Confirmation DialogBox
TITLE.A, ; Title for Dialog Box, or "" for Default
MESSAGE.A, ; Message to display (< 70 chars)
MSGCOLOR.N, ; Color for message (not DialogBox!)
DBOXPALETTE.A, ; Palette name for custom dBox window colors
ALERT.N, ; Sound level of Alert (0 - 4)
OKLABEL.A, ; Label of CONTINUE Pushbutton
CXLABEL.A, ; Label of CANCEL Pushbutton
CONFIRM.L) ; Should Confirm be default?
PRIVATE WIDTH.N, ; Width of Dialog Box
A1, A2, ; Match variables
N1, N2, ; Button length comparisons
BUTTONLENGTH.N, ; Width of Pushbuttons
BUTTON.L, ; Value of selected Pushbutton
ONCEFLAG.L, ; True = Non-continuous Alert
ICON.A,
FRAMEHIGH.N,
FRAMELOW.N
;Global g.appcolors.y ; Global Application Colors
; g.sysinfo.y ; Global System Information
SETCANVAS DEFAULT
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y
ENDIF
IF LEN(MESSAGE.A) = 1 THEN
ICON.A = MSICON.A(MESSAGE.A)
MESSAGE.A = MSSHORTCUTS.A(MESSAGE.A)
ELSE
IF ALERT.N > 3 THEN
ICON.A = MSICON.A("!")
ELSE
ICON.A = MSICON.A("?")
ENDIF
ENDIF
FRAMEHIGH.N = INATTRIBUTECONVERT.N(SYSCOLOR(1036),TRUE)
FRAMELOW.N = INATTRIBUTECONVERT.N(SYSCOLOR(1036),FALSE)
ONCEFLAG.L = ALERT.N < 3 OR ALERT.N > 50
BUTTON.L = FALSE
MESSAGE.A = MSWRAP.A(MESSAGE.A)
TITLE.A = IIF(TITLE.A = "", "Press <Tab> to Highlight - <Enter> to Select",
TITLE.A)
DYNARRAY DBOXPROCS.Y[]
DBOXPROCS.Y["IDLE"] = "dbAlert.l"
TOPROW.N = 7
LEFTCOL.N = INT((G.SYSINFO.Y["ScreenWidth"]-60)/2)
A1 = ""
A2 = OKLABEL.A
WHILE MATCH(A1+A2,"..~..",A1,A2)
ENDWHILE
N1 = LEN(A1+A2)
A1 = ""
A2 = CXLABEL.A
WHILE MATCH(A1+A2,"..~..",A1,A2)
ENDWHILE
N2 = LEN(A1+A2)
BUTTONLENGTH.N = MAX(N1,N2)+4
SHOWDIALOG TITLE.A
PROC "dbEventHandler.l"
IDLE
TRIGGER "Open"
@ -200,-200
HEIGHT 11 WIDTH 60
FRAME FROM 0,1 TO 6,11
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,1,6,11
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,1,0,10
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,1,6,1
PAINTCANVAS FILL ICON.A ATTRIBUTE MSGCOLOR.N 1,2,5,10
FRAME FROM 0,13 TO 6,56
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,13,6,56
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,13,0,55
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,13,6,13
PAINTCANVAS FILL MESSAGE.A ATTRIBUTE MSGCOLOR.N 1,15,5,54
PUSHBUTTON @ 7,10
WIDTH BUTTONLENGTH.N IIF(CONFIRM.L,OKLABEL.A,CXLABEL.A)
OK VALUE DBBUTTONPRESS.V(CONFIRM.L) TAG "BUTTON"
TO BUTTON.L
PUSHBUTTON @ 7,48 - BUTTONLENGTH.N
WIDTH BUTTONLENGTH.N IIF(CONFIRM.L,CXLABEL.A,OKLABEL.A)
OK VALUE DBBUTTONPRESS.V(NOT CONFIRM.L) TAG "BUTTON"
TO BUTTON.L
ENDDIALOG
MSWORKINGCLEAR.U()
RETURN BUTTON.L
ENDPROC
WRITELIB LIBNAME MSCONFIRM!.L
RELEASE VARS MSCONFIRM!.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msConfirm!.l")
; ============================================================================
; TITLE: msContinue!.u (c) 1991 - 1993 DataStar International
; RETURNS: No Value
; DESCRIPTION: Generic Message and wait for a <Continue> keypress
; Alert 0 = No sound
; Alert 1 = Three beeps
; Alert 2 = Siren, short (high-low-high-low-high)
; Alert 3 = Two beeps, continuous
; Alert 4 = Two high beeps, two low beeps, continuous
; Alert 5 = Siren, continuous
; ----------------------------------------------------------------------------
PROC MSCONTINUE!.U( ; Generic Continue DialogBox
TITLE.A, ; Title for dBox, "" for Default
MESSAGE.A, ; Message to display
MSGCOLOR.N, ; Color for Message (not DialogBox!)
DBOXPALETTE.A, ; Dynarray of custom colors
ALERT.N) ; Sound level of Alert (0 - 5)
PRIVATE ICON.A,
BUTTON.L, ; Value of selected Pushbutton
ONCEFLAG.L, ; True = non-continuous alert
FRAMEHIGH.N,
FRAMELOW.N
;Global g.appcolors.y ; Global Application Colors
; g.sysinfo.y ; Global System Information
SETCANVAS DEFAULT
IF LEN(MESSAGE.A) = 1 THEN
ICON.A = MSICON.A(MESSAGE.A)
MESSAGE.A = MSSHORTCUTS.A(MESSAGE.A)
ELSE
IF ALERT.N > 3 THEN
ICON.A = MSICON.A("!")
ELSE
ICON.A = MSICON.A("I")
ENDIF
ENDIF
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y
ENDIF
DYNARRAY DBOXPROCS.Y[]
DBOXPROCS.Y["IDLE"] = "dbAlert.l"
FRAMEHIGH.N = INATTRIBUTECONVERT.N(SYSCOLOR(1036),TRUE)
FRAMELOW.N = INATTRIBUTECONVERT.N(SYSCOLOR(1036),FALSE)
ONCEFLAG.L = ALERT.N < 3 OR ALERT.N > 50
MESSAGE.A = MSWRAP.A(MESSAGE.A)
BUTTON.L = TRUE
TOPROW.N = 7
LEFTCOL.N = INT((G.SYSINFO.Y["ScreenWidth"]-60)/2)
TITLE.A = IIF(TITLE.A = "", "Press <Enter> to Continue", TITLE.A)
SHOWDIALOG TITLE.A
PROC "dbEventHandler.l"
IDLE TRIGGER "OPEN" ; Wait for Key Alert
@ -200,-200
HEIGHT 11 WIDTH 60
FRAME FROM 0,1 TO 6,11
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,1,6,11
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,1,0,10
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,1,6,1
PAINTCANVAS FILL ICON.A
ATTRIBUTE MSGCOLOR.N 1,2,5,10
FRAME FROM 0,13 TO 6,56
PAINTCANVAS BORDER ATTRIBUTE FRAMEHIGH.N 0,13,6,56
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,13,0,55
PAINTCANVAS BORDER ATTRIBUTE FRAMELOW.N 0,13,6,13
PAINTCANVAS FILL MESSAGE.A
ATTRIBUTE MSGCOLOR.N 1,15,5,54
PUSHBUTTON @ 7,23
WIDTH 12 "~C~ontinue"
OK DEFAULT VALUE DBBUTTONPRESS.V(TRUE) TAG "OK"
TO BUTTON.L
ENDDIALOG
MSWORKINGCLEAR.U()
RETURN
ENDPROC
WRITELIB LIBNAME MSCONTINUE!.U
RELEASE VARS MSCONTINUE!.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msContinue!.u")
; ============================================================================
; TITLE: dbEventHandler.l (c) 1991 - 1993 DataStar International
; RETURNS: Logical true/false id dBox accepted
; DESCRIPTION: Generic Dialog Box Event Handler
; ----------------------------------------------------------------------------
PROC DBEVENTHANDLER.L( ; Alert Siren in Idle Dialog Box
TYPE.A, ; EVENT, or TRIGGER Name
TAG.A, ; Control element tag or null
EVENT.V, ; DynArray of GetEvent, or control value
ELEMENT.A) ; Checkbox label or null
PRIVATE H, ; Transient window handle
Y, ; Transient window attributes dynarray
RETVAL.L, ; Value to return
DBOXCOLORS.Y, ; Custom Dialog Box Color Palette
PROCTAG.A ; Trigger name, or event type
;Global alert.n ; Alert Value from dBox (0 - 5)
; onceflag.l ; For non-continuous Alert (1, 2)
; dboxpalette.a ; Palette name for custom colors
; starticks.n ; Starting Ticks, if assigned, enables timeout
; frametag.a ; Can be used by calling proc to paint frame
RETVAL.L = TRUE
SWITCH
CASE TYPE.A = "OPEN" :
IF ISASSIGNED(DBOXPROCS.Y["OPEN"]) THEN
EXECPROC DBOXPROCS.Y["OPEN"]
RETVAL.L = RETVAL
ELSE
WINDOW HANDLE DIALOG TO H
DYNARRAY Y[]
Y["OriginRow"] = TOPROW.N
Y["OriginCol"] = LEFTCOL.N
IF ISASSIGNED(DBOXPALETTE.A) AND NOT ISBLANK(DBOXPALETTE.A) THEN
DBPALETTESET.U(DBOXPALETTE.A)
WINDOW SETCOLORS H FROM DBOXCOLORS.Y
REPAINTDIALOG
ENDIF
WINDOW SETATTRIBUTES H FROM Y
ENDIF
CASE TYPE.A = "IDLE" :
IF ISASSIGNED(DBOXPROCS.Y["IDLE"]) THEN
EXECPROC DBOXPROCS.Y["IDLE"]
RETVAL.L = RETVAL
ELSE
IF ISASSIGNED(STARTICKS.N) AND TICKS() > STARTICKS.N + 600000 THEN
CANCELDIALOG
ENDIF
ENDIF
OTHERWISE :
PROCTAG.A = IIF(TYPE.A = "EVENT",EVENT.V["Type"],TYPE.A)
IF ISASSIGNED(DBOXPROCS.Y[proctag.a]) THEN
EXECPROC DBOXPROCS.Y[proctag.a]
RETVAL.L = RETVAL
ENDIF
ENDSWITCH
FRAMETAG.A = TAG.A
REPAINTDIALOG
RETURN RETVAL.L
ENDPROC
WRITELIB LIBNAME DBEVENTHANDLER.L
RELEASE VARS DBEVENTHANDLER.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "dbEventHandler.l")
; ============================================================================
; TITLE: dbAlert.l (c) 1991 - 1993 DataStar International
; RETURNS: True, for dBox Event Handler
; DESCRIPTION: Dialog Event Handler proc for IDLE event Alerts
; ----------------------------------------------------------------------------
PROC DBALERT.L() ; Idle Alert called from Event Handler
PRIVATE N1, N2 ; Transient loop counter
;Global alert.n ; Alert Value from dBox (0 - 5)
; onceflag.l ; For non-continuous Alert (1, 2)
IF NOT ISASSIGNED(ONCEFLAG.L) THEN
ONCEFLAG.L = TRUE
ENDIF
SWITCH
CASE ALERT.N = 1 AND ONCEFLAG.L :
BEEP SLEEP 50
BEEP SLEEP 50
BEEP
ONCEFLAG.L = FALSE ; Turns off subsequent Alerts
CASE ALERT.N = 2 AND ONCEFLAG.L :
SOUND 770 150
SOUND 440 150
SOUND 770 150
SOUND 440 150
SOUND 770 150
ONCEFLAG.L = FALSE ; Turns off subsequent Alerts
CASE ALERT.N = 3 :
BEEP SLEEP 50 BEEP SLEEP 1000
CASE ALERT.N = 4 :
SOUND 300 50 SLEEP 100
SOUND 300 50 SLEEP 100
SOUND 150 50 SLEEP 100
SOUND 150 50 SLEEP 100
SLEEP 200
CASE ALERT.N = 5 :
SOUND 770 150
SOUND 440 150
CASE ALERT.N = 86 AND ONCEFLAG.L :
FOR N1 FROM 4 TO 0 STEP -1
FOR N2 FROM 11 TO 0 STEP -1
SOUND INT(POW(2,N1+N2/12)*110) 5
ENDFOR
ENDFOR
SOUND 10 3000
ONCEFLAG.L = FALSE ; Turns off subsequent Alerts
ENDSWITCH
RETURN TRUE
ENDPROC
WRITELIB LIBNAME DBALERT.L
RELEASE VARS DBALERT.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "dbAlert.l")
; ============================================================================
; TITLE: dbButtonPress.v (c) 1991 - 1993 DataStar International
; RETURNS: Whatever value is passed as parameter
; DESCRIPTION: Adds 300 millisecond delay to PushButton press
; ----------------------------------------------------------------------------
PROC DBBUTTONPRESS.V( ; Adds 300 ms delay to button press
RETVAL.V) ; Value to assign to Pushbutton variable
SLEEP 300
RETURN RETVAL.V
ENDPROC
WRITELIB LIBNAME DBBUTTONPRESS.V
RELEASE VARS DBBUTTONPRESS.V
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "dbButtonPress.v")
; ============================================================================
; TITLE: dbPaletteSet.u (c) 1991 - 1993 DataStar International
; RETURNS: No value (sets local global dynarray: dboxcolors.y)
; DESCRIPTION: Creates a dynarray of dialog box colors based upon palette.a
; ----------------------------------------------------------------------------
PROC DBPALETTESET.U( ; Creates Palette for Dialog Boxes
PALETTE.A)
;Global dboxcolors.y
DYNARRAY DBOXCOLORS.Y[]
SWITCH
CASE UPPER(PALETTE.A) = "BLUE" :
DBOXCOLORS.Y["1"] = 27 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 26 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 48 ; Scroll bar
DBOXCOLORS.Y["4"] = 63 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 31 ; Default background text
DBOXCOLORS.Y["6"] = 23 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 31 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 30 ; Label hot key
DBOXCOLORS.Y["9"] = 48 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 59 ; Text for default push button label
DBOXCOLORS.Y["11"] = 63 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 62 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 16 ; Button shadow
DBOXCOLORS.Y["16"] = 27 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 31 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 30 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 63 ; Normal typein box text
DBOXCOLORS.Y["19"] = 47 ; Selected typein box text
DBOXCOLORS.Y["20"] = 49 ; Typein box arrows
DBOXCOLORS.Y["25"] = 48 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 47 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 63 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 49 ; Column dividers
FRAMEHIGH.N = 25 ; Frame highlight (sunny side)
FRAMELOW.N = 16 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "RED" :
DBOXCOLORS.Y["1"] = 79 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 75 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 112 ; Scroll bar
DBOXCOLORS.Y["4"] = 127 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 71 ; Default background text
DBOXCOLORS.Y["6"] = 65 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 79 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 78 ; Label hot key
DBOXCOLORS.Y["9"] = 112 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 116 ; Text for default push button label
DBOXCOLORS.Y["11"] = 127 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 126 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 64 ; Button shadow
DBOXCOLORS.Y["16"] = 71 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 79 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 78 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 31 ; Normal typein box text
DBOXCOLORS.Y["19"] = 47 ; Selected typein box text
DBOXCOLORS.Y["20"] = 27 ; Typein box arrows
DBOXCOLORS.Y["25"] = 112 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 31 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 127 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 116 ; Column dividers
FRAMEHIGH.N = 76 ; Frame highlight (sunny side)
FRAMELOW.N = 64 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "CYAN" :
DBOXCOLORS.Y["1"] = 63 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 59 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 23 ; Scroll bar
DBOXCOLORS.Y["4"] = 31 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 49 ; Default background text
DBOXCOLORS.Y["6"] = 48 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 63 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 62 ; Label hot key
DBOXCOLORS.Y["9"] = 27 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 29 ; Text for default push button label
DBOXCOLORS.Y["11"] = 31 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 30 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 48 ; Button shadow
DBOXCOLORS.Y["16"] = 49 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 63 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 62 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 31 ; Normal typein box text
DBOXCOLORS.Y["19"] = 47 ; Selected typein box text
DBOXCOLORS.Y["20"] = 27 ; Typein box arrows
DBOXCOLORS.Y["25"] = 112 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 31 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 127 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 115 ; Column dividers
FRAMEHIGH.N = 59 ; Frame highlight (sunny side)
FRAMELOW.N = 48 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "GREEN" :
DBOXCOLORS.Y["1"] = 47 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 43 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 96 ; Scroll bar
DBOXCOLORS.Y["4"] = 111 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 32 ; Default background text
DBOXCOLORS.Y["6"] = 42 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 47 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 46 ; Label hot key
DBOXCOLORS.Y["9"] = 27 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 29 ; Text for default push button label
DBOXCOLORS.Y["11"] = 31 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 30 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 32 ; Button shadow
DBOXCOLORS.Y["16"] = 33 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 47 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 46 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 112 ; Normal typein box text
DBOXCOLORS.Y["19"] = 31 ; Selected typein box text
DBOXCOLORS.Y["20"] = 114 ; Typein box arrows
DBOXCOLORS.Y["25"] = 112 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 31 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 127 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 114 ; Column dividers
FRAMEHIGH.N = 42 ; Frame highlight (sunny side)
FRAMELOW.N = 32 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "BROWN" :
DBOXCOLORS.Y["1"] = 111 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 107 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 112 ; Scroll bar
DBOXCOLORS.Y["4"] = 127 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 96 ; Default background text
DBOXCOLORS.Y["6"] = 97 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 111 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 110 ; Label hot key
DBOXCOLORS.Y["9"] = 27 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 29 ; Text for default push button label
DBOXCOLORS.Y["11"] = 31 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 30 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 96 ; Button shadow
DBOXCOLORS.Y["16"] = 97 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 111 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 110 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 112 ; Normal typein box text
DBOXCOLORS.Y["19"] = 47 ; Selected typein box text
DBOXCOLORS.Y["20"] = 118 ; Typein box arrows
DBOXCOLORS.Y["25"] = 112 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 47 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 127 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 118 ; Column dividers
FRAMEHIGH.N = 110 ; Frame highlight (sunny side)
FRAMELOW.N = 96 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "MAGENTA" :
DBOXCOLORS.Y["1"] = 95 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 91 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 23 ; Scroll bar
DBOXCOLORS.Y["4"] = 31 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 80 ; Default background text
DBOXCOLORS.Y["6"] = 81 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 95 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 94 ; Label hot key
DBOXCOLORS.Y["9"] = 27 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 29 ; Text for default push button label
DBOXCOLORS.Y["11"] = 31 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 30 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 80 ; Button shadow
DBOXCOLORS.Y["16"] = 81 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 95 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 94 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 112 ; Normal typein box text
DBOXCOLORS.Y["19"] = 31 ; Selected typein box text
DBOXCOLORS.Y["20"] = 113 ; Typein box arrows
DBOXCOLORS.Y["25"] = 112 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 31 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 127 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 117 ; Column dividers
FRAMEHIGH.N = 93 ; Frame highlight (sunny side)
FRAMELOW.N = 80 ; Frame lowlight (shadow side)
CASE UPPER(PALETTE.A) = "GRAY" :
DBOXCOLORS.Y["1"] = 127 ; Active dialog box frame and title
DBOXCOLORS.Y["2"] = 123 ; Selected dialog box frame when dragging
DBOXCOLORS.Y["3"] = 19 ; Scroll bar
DBOXCOLORS.Y["4"] = 27 ; Scroll bar controls
DBOXCOLORS.Y["5"] = 112 ; Default background text
DBOXCOLORS.Y["6"] = 113 ; Label when linked control is inactive
DBOXCOLORS.Y["7"] = 127 ; Label when linked control is active
DBOXCOLORS.Y["8"] = 126 ; Label hot key
DBOXCOLORS.Y["9"] = 32 ; Text for normal push button label
DBOXCOLORS.Y["10"] = 43 ; Text for default push button label
DBOXCOLORS.Y["11"] = 47 ; Text for selected push button label
DBOXCOLORS.Y["13"] = 46 ; Hot key for push button label
DBOXCOLORS.Y["14"] = 112 ; Button shadow
DBOXCOLORS.Y["16"] = 112 ; Normal radio button / check box
DBOXCOLORS.Y["16"] = 127 ; Highlighted radio button / check box
DBOXCOLORS.Y["17"] = 126 ; Hot key for radio button / check box
DBOXCOLORS.Y["18"] = 31 ; Normal typein box text
DBOXCOLORS.Y["19"] = 47 ; Selected typein box text
DBOXCOLORS.Y["20"] = 26 ; Typein box arrows
DBOXCOLORS.Y["25"] = 48 ; Normal pick list item text
DBOXCOLORS.Y["26"] = 47 ; Selected text when pick list is active
DBOXCOLORS.Y["27"] = 63 ; Selected text when pick list is inactive
DBOXCOLORS.Y["28"] = 55 ; Column dividers
FRAMEHIGH.N = 127 ; Frame highlight (sunny side)
FRAMELOW.N = 112 ; Frame lowlight (shadow side)
ENDSWITCH
RETURN
ENDPROC
WRITELIB LIBNAME DBPALETTESET.U
RELEASE VARS DBPALETTESET.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "dbPaletteSet.u")
; ============================================================================
; TITLE: msWrap.a (c) 1991 - 1993 DataStar International
; RETURNS: Formatted 200 char message
; DESCRIPTION: Formats message for dBox message routines
; ----------------------------------------------------------------------------
PROC MSWRAP.A( ; Formats message for dBox
MESSAGE.A) ; Message to format
PRIVATE N1,
N2,
N3
IF LEN(MESSAGE.A) < 41 THEN
MESSAGE.A = SPACES(80) + FORMAT("w40,ac",MESSAGE.A) + SPACES(80)
ELSE
IF LEN(MESSAGE.A) < 121 THEN
MESSAGE.A = SPACES(40) + MESSAGE.A
ENDIF
FOR N1 FROM 40 TO 160 STEP 40
N2 = N1 + 1
WHILE SUBSTR(MESSAGE.A, N2, 1) <> " "
N2 = N2 - 1
ENDWHILE
N3 = N2 + 1
WHILE SUBSTR(MESSAGE.A, N3, 1) = " "
N3 = N3 + 1
ENDWHILE
MESSAGE.A = FORMAT("w"+STRVAL(N1),SUBSTR(MESSAGE.A,1,N2-1)) +
FORMAT("w"+STRVAL(200-N1),SUBSTR(MESSAGE.A,N3,200))
ENDFOR
ENDIF
RETURN MESSAGE.A
ENDPROC
WRITELIB LIBNAME MSWRAP.A
RELEASE VARS MSWRAP.A
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msWrap.a")
; ============================================================================
; TITLE: inAttributeConvert.n (c) 1991 - 1993 DataStar International
; RETURNS: Color attribute
; DESCRIPTION: Returns either the intense foreground of a background color if
; highlight.l = true, else black on background color.
; ----------------------------------------------------------------------------
PROC INATTRIBUTECONVERT.N( ; Converts color into highlight or lowlight
COLOR.N, ; Background color
HIGHLIGHT.L) ; True=highlight, false=lowlight
RETURN (INT(COLOR.N/16)*16) + IIF(HIGHLIGHT.L,INT(COLOR.N/16)+8,0)
ENDPROC
WRITELIB LIBNAME INATTRIBUTECONVERT.N
RELEASE VARS INATTRIBUTECONVERT.N
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "InAttributeConvert.n")
; ============================================================================
; TITLE: msShortcuts.a (c) 1991 - 1993 DataStar International
; RETURNS: Expanded Message Value
; DESCRIPTION: Shortcuts for Generic Information Messages
; ----------------------------------------------------------------------------
PROC MSSHORTCUTS.A( ; Shortcuts for Messages
MESSAGE.A) ; Message Code
SWITCH ; shortcuts
CASE MESSAGE.A = "C" : MESSAGE.A = "Operation Canceled - Returning"
CASE MESSAGE.A = "M" : MESSAGE.A = "One Moment - Returning to MENU"
CASE MESSAGE.A = "P" : MESSAGE.A = "P R I N T I N G - This will take a few moments"
CASE MESSAGE.A = "Q" : MESSAGE.A = "Q U E R Y I N G - This will take a few moments"
CASE MESSAGE.A = "R" : MESSAGE.A = "Report NOT Printed - Returning"
CASE MESSAGE.A = "W" : MESSAGE.A = "W O R K I N G - One Moment"
CASE MESSAGE.A = "K" : MESSAGE.A = "Key Violation! Do You Want to Overwrite the Existing Record?"
CASE MESSAGE.A = "A" : MESSAGE.A = "A R E Y O U S U R E ?"
CASE MESSAGE.A = "U" : MESSAGE.A = "Unable to Lock Necessary Tables, Please Try Later"
CASE MESSAGE.A = "N" : MESSAGE.A = "The Printer is NOT Responding! Please fix Printer, or Cancel Report"
CASE MESSAGE.A = "D" : MESSAGE.A = "Do You Want to DELETE This Record?"
OTHERWISE : MESSAGE.A = "DataStar International"
ENDSWITCH
RETURN MESSAGE.A
ENDPROC
WRITELIB LIBNAME MSSHORTCUTS.A
RELEASE VARS MSSHORTCUSTS.A
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msShortCuts.a")
; ============================================================================
; TITLE: msIcon.a (c) 1991 - 1993 DataStar International
; RETURNS: String containing message box icon
; DESCRIPTION: Assigns Icon based upon icon code
; ----------------------------------------------------------------------------
PROC MSICON.A( ; Create icon for message dBoxes
ICON.A)
ICON.A = UPPER(ICON.A)
SWITCH
CASE SEARCH(ICON.A,"IWM") <> 0 :
ICON.A = " ▀ " +
" ██ " +
" █ " +
" █ " +
" ███ "
CASE SEARCH(ICON.A,"DKA?") <> 0 :
ICON.A = " █▀▀▀▀█ " +
" █ " +
" █▀▀ " +
" █ " +
" ▄ "
CASE SEARCH(ICON.A,"!U") <> 0 :
ICON.A = " ▐█▌ " +
" ███ " +
" ▐█▌ " +
" █ " +
" ▄ "
CASE SEARCH(ICON.A,"PN") <> 0 :
ICON.A = " █████ " +
" █████ " +
" █████ " +
"┌─┬─┬─┬─┐" +
"▀███████▀"
CASE SEARCH(ICON.A,"CR") <> 0 :
ICON.A = " ▄ ▄ " +
" ▀▄ ▄▀ " +
" ▄▀▄ " +
" ▄▀ ▀▄ " +
" "
OTHERWISE :
ICON.A = " █ " +
" ▄█▀█▄ " +
"▀▀█▄▀▄█▀▀" +
" ▀█▀ " +
" ▀ "
ENDSWITCH
RETURN ICON.A
ENDPROC
WRITELIB LIBNAME MSICON.A
RELEASE VARS MSICON.A
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msIcon.a")
; ============================================================================
; TITLE: quExecute.l (c) 1991 - 1993 DataStar International
; RETURNS: Logical true/false IF Query successful
; DESCRIPTION: Generic Query processor
; ----------------------------------------------------------------------------
PROC QUEXECUTE.L( ; Generic Query Processor
CLEAR.L) ; Should resultant table be cleared?
PRIVATE ERROR.L, ; Error routine flag
PROC.A, ; Name of current procedure
RETVAL.L ; Value to return
PROC.A = "quExecute.l"
ERROR.L = FALSE
DO_IT! ; Main Errorproc checks IF Query Completes
IF ERROR.L OR WINDOW() <> "" THEN
; MSCONTINUE!.U("","Query Error - " + WINDOW(),79,"RED",4)
RETVAL.L = FALSE
IF ISASSIGNED(G.DEBUG.L) AND G.DEBUG.L THEN
DEBUG
ENDIF
ELSE
IF CLEAR.L THEN
CLEARIMAGE
ENDIF
WHILE NIMAGES() > 0
MOVETO 1
IF IMAGETYPE() = "Query" THEN
CLEARIMAGE
ELSE
QUITLOOP
ENDIF
ENDWHILE
RETVAL.L = TRUE
ENDIF
RETURN RETVAL.L
ENDPROC
WRITELIB LIBNAME QUEXECUTE.L
RELEASE VARS UQEXECUTE.L
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "quExecute.l")
;══════════════════════════════════════════════════════════════════════════════
; PROCEDURE: wbsFillScreen()
; COPYRIGHT: (c) 1991-1992 Weston Brothers Software, Inc.
; AUTHOR: Angelo Laudon
; DESCRIPTION: Fills the full screen canvas with the default Paradox
; background character in its current color setting.
; PARAMETERS: N/A
; RETURNS: N/A
; SPECIAL NOTE: N/A
; used with expressed consent for CISMSG Application
;══════════════════════════════════════════════════════════════════════════════
PROC WBSFILLSCREEN()
PRIVATE SAVECANVAS, SYS
SAVECANVAS = GETCANVAS()
SETCANVAS DEFAULT
SYSINFO TO SYS
PAINTCANVAS FILL "░" ATTRIBUTE SYSCOLOR(1000)
0, 0, SYS["SCREENHEIGHT"] - 1, SYS["SCREENWIDTH"] - 1
; SETCANVAS SaveCanvas
SETCANVAS DEFAULT
ENDPROC
WRITELIB LIBNAME WBSFILLSCREEN
RELEASE VARS WBSFILLSCREEN
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "wbsFillScreen")
; ============================================================================
; TITLE: msProgressBar.u() (c) 1991 - 1993 DataStar International
; RETURNS: No Value
; DESCRIPTION: Displays progress bar on screen indicating to user
; processing messages and percent complete.
; ----------------------------------------------------------------------------
PROC MSPROGRESSBAR.U( ; Creates Progress Bar thermometer
TOPROW.N, ; Top row for Window
LEFTCOL.N, ; Left column for Window
TITLE.A, ; Title for bar
MESSAGE.A, ; Message, below title
WINCOLOR.N, ; Color of Window, includes Title
BARCOLOR.N, ; Color of Bar
MSGCOLOR.N, ; Color of Message
PERCENTDONE.N) ; 0 = SetUpWindow and MoveIntoPosition
PRIVATE Y, ; Throwaway Window DynArray
OLDCANVAS.H, ; Current Canvas
OLDWINDOW.H ; Current Window
;Global g.sysinfo.y ; SysInfo
; g.handles.y ; Window Handles
OLDWINDOW.H = GETWINDOW()
OLDCANVAS.H = GETCANVAS()
IF PERCENTDONE.N = -1 THEN
WINDOW SELECT G.HANDLES.Y["PROGRESS"]
SETCANVAS G.HANDLES.Y["PROGRESS"]
WINCLOSE
ELSE
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y
ENDIF
DYNARRAY Y[]
Y["hasframe"] = FALSE
Y["Style"] = WINCOLOR.N
Y["height"] = 8
Y["width"] = 64
IF NOT ISASSIGNED(G.HANDLES.Y) THEN
DYNARRAY G.HANDLES.Y[]
ENDIF
IF NOT ISASSIGNED(G.HANDLES.Y["PROGRESS"]) OR
NOT ISWINDOW(G.HANDLES.Y["PROGRESS"]) THEN
WINDOW CREATE FLOATING @ -200, -200
ATTRIBUTES Y TO G.HANDLES.Y["PROGRESS"]
ENDIF
WINDOW SELECT G.HANDLES.Y["PROGRESS"]
SETCANVAS G.HANDLES.Y["PROGRESS"]
CANVAS OFF
IF TOPROW.N = 999 THEN
TOPROW.N = 7
ENDIF
IF LEFTCOL.N = 999 THEN
LEFTCOL.N = INT((G.SYSINFO.Y["ScreenWidth"]-64)/2)
ENDIF
IF PERCENTDONE.N = 0 THEN ; 0 = 1st time through Setup
WINDOW MOVE G.HANDLES.Y["PROGRESS"] TO TOPROW.N,LEFTCOL.N
@ 0,0 ??"┌──────────────────────────────────────────────────────────────┐"
@ 1,0 ??"│ │"
@ 2,0 ??"│ │"
@ 3,0 ??"│ │"
@ 4,0 ??"│ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ │"
@ 5,0 ??"│ 0 25 50 75 100 │"
@ 6,0 ??"│ Percent Complete │"
@ 7,0 ??"└──────────────────────────────────────────────────────────────┘"
@ 1,2 ?? FORMAT("ac,w60",TITLE.A)
PAINTCANVAS ATTRIBUTE WINCOLOR.N 0,0,6,63
PAINTCANVAS ATTRIBUTE BARCOLOR.N 4,6,4,57
PAINTCANVAS BORDER ATTRIBUTE 112 0,0,7,63
PAINTCANVAS ATTRIBUTE 127 0,0,7,0
PAINTCANVAS ATTRIBUTE 127 7,0,7,62
ENDIF
STYLE ATTRIBUTE MSGCOLOR.N
@ 2,2 ?? FORMAT("ac,w60",MESSAGE.A)
STYLE ATTRIBUTE BARCOLOR.N
@ 4,7 ?? FILL("\219",MIN(INT(PERCENTDONE.N/2),50))
STYLE
CANVAS ON
ENDIF
IF ISWINDOW(OLDCANVAS.H) THEN
SETCANVAS OLDCANVAS.H
ELSE
SETCANVAS DEFAULT
ENDIF
IF ISWINDOW(OLDWINDOW.H) THEN
WINDOW SELECT OLDWINDOW.H
ENDIF
RETURN
ENDPROC
WRITELIB LIBNAME MSPROGRESSBAR.U
RELEASE VARS MSPROGRESSBAR.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "msProgressBar.u")
;══════════════════════════BSC═══════════════════════════════════════
; PROCEDURE : MtHProgressMsg.U
; AUTHOR : Mark T. Houpt
; COPYRIGHT : (C) 1993 BAT-Systems Consulting
; PARAMETERS : See Below
;
;
;
; RETURNS : No Value
;
; Special Info: Addapted from DataStar Int. msProgressBar.u This is an
; Updated Progress Msg Window
;═══════════════════════════BSC════════════════════════════════════════
; Major Portions (c) 1991 - 1993 DataStar International
; ---------------------------------------------------------------------
PROC MtHPROGRESSMSG.U( ; Creates Progress Bar thermometer
TOPROW.N, ; Top row for Window
LEFTCOL.N, ; Left column for Window
TITLE.A, ; Title for bar - Must be Under 40 characters
MESSAGE.A, ; Message, below title - Must Be unnder 40 Characters
WINCOLOR.N, ; Color of Window, includes Title
MSGCOLOR.N, ; Color of Message
Pass.n) ; 0 = SetUpWindow and -1 to close
PRIVATE Y, ; Throwaway Window DynArray
OLDCANVAS.H, ; Current Canvas
OLDWINDOW.H ; Current Window
;Global g.sysinfo.y ; SysInfo
; g.handles.y ; Window Handles
OLDWINDOW.H = GETWINDOW()
OLDCANVAS.H = GETCANVAS()
IF PASS.N = -1 THEN
WINDOW SELECT G.HANDLES.Y["PROGRESSMSG"]
SETCANVAS G.HANDLES.Y["PROGRESSMSG"]
WINCLOSE
ELSE
IF NOT ISASSIGNED(G.SYSINFO.Y) THEN
SYSINFO TO G.SYSINFO.Y
ENDIF
DYNARRAY Y[]
Y["hasframe"] = FALSE
Y["Style"] = WINCOLOR.N
Y["height"] = 6
Y["width"] = 44
IF NOT ISASSIGNED(G.HANDLES.Y) THEN
DYNARRAY G.HANDLES.Y[]
ENDIF
IF NOT ISASSIGNED(G.HANDLES.Y["PROGRESSMSG"]) OR
NOT ISWINDOW(G.HANDLES.Y["PROGRESSMSG"]) THEN
WINDOW CREATE FLOATING @ -200, -200
ATTRIBUTES Y TO G.HANDLES.Y["PROGRESSMSG"]
ENDIF
WINDOW SELECT G.HANDLES.Y["PROGRESSMSG"]
SETCANVAS G.HANDLES.Y["PROGRESSMSG"]
CANVAS OFF
IF TOPROW.N = 999 THEN
TOPROW.N = 7
ENDIF
IF LEFTCOL.N = 999 THEN
LEFTCOL.N = INT((G.SYSINFO.Y["ScreenWidth"]-64)/2)
ENDIF
IF Pass.N = 0 THEN ; 0 = 1st time through Setup
WINDOW MOVE G.HANDLES.Y["PROGRESSMSG"] TO TOPROW.N,LEFTCOL.N
@ 0,0 ??"┌──────────────────────────────────────────┐"
@ 1,0 ??"│ │"
@ 2,0 ??"│ │"
@ 3,0 ??"│ │"
@ 4,0 ??"│ │"
@ 5,0 ??"└──────────────────────────────────────────┘"
@ 1,2 ?? FORMAT("ac,w40",TITLE.A)
PAINTCANVAS ATTRIBUTE WINCOLOR.N 0,0,6,43
PAINTCANVAS BORDER ATTRIBUTE 112 0,0,7,43
PAINTCANVAS ATTRIBUTE 127 0,0,7,0
PAINTCANVAS ATTRIBUTE 127 7,0,7,42
ENDIF
STYLE ATTRIBUTE MSGCOLOR.N
@ 3,2 ?? FORMAT("ac,w40",MESSAGE.A)
@ 4,22
if Pass.n = 1 then
CURSOR BAR
endif
CANVAS ON
ENDIF
IF ISWINDOW(OLDCANVAS.H) THEN
SETCANVAS OLDCANVAS.H
ELSE
SETCANVAS DEFAULT
ENDIF
IF ISWINDOW(OLDWINDOW.H) THEN
WINDOW SELECT OLDWINDOW.H
ENDIF
IF Pass.n = - 1 then
CURSOR NORMAL
ENDIF
RETURN
ENDPROC
WRITELIB LIBNAME MtHPROGRESSMSG.U
RELEASE VARS MtHPROGRESSMSG.U
LB_DISPLAYPROGRESS.U(PROCTOTAL.N, "MtHProgressMSG.u")